diff options
Diffstat (limited to 'src/aterm-helper.pl')
| -rwxr-xr-x | src/aterm-helper.pl | 179 |
1 files changed, 0 insertions, 179 deletions
diff --git a/src/aterm-helper.pl b/src/aterm-helper.pl deleted file mode 100755 index f1eb77ee8..000000000 --- a/src/aterm-helper.pl +++ /dev/null @@ -1,179 +0,0 @@ -#! /usr/bin/perl -w - -# This program generates C/C++ code for efficiently manipulating -# ATerms. It generates functions to build and match ATerms according -# to a set of constructor definitions defined in a file read from -# standard input. A constructor is defined by a line with the -# following format: -# -# SYM | ARGS | TYPE | FUN? -# -# where SYM is the name of the constructor, ARGS is a -# whitespace-separated list of argument types, TYPE is the type of the -# resulting ATerm (which should be `ATerm' or a type synonym for -# `ATerm'), and the optional FUN is used to construct the names of the -# build and match functions (it defaults to SYM; overriding it is -# useful if there are overloaded constructors, e.g., with different -# arities). Note that SYM may be empty. -# -# A line of the form -# -# VAR = EXPR -# -# causes a ATerm variable to be generated that is initialised to the -# value EXPR. -# -# Finally, a line of the form -# -# init NAME -# -# causes the initialisation function to be called `NAME'. This -# function must be called before any of the build/match functions or -# the generated variables are used. - -die if scalar @ARGV != 2; - -my $syms = ""; -my $init = ""; -my $initFun = "init"; - -open HEADER, ">$ARGV[0]"; -open IMPL, ">$ARGV[1]"; - -print HEADER "#include <aterm2.h>\n"; -print HEADER "#ifdef __cplusplus\n"; -print HEADER "namespace nix {\n"; -print HEADER "#endif\n\n\n"; -print IMPL "namespace nix {\n"; - -while (<STDIN>) { - s/\#.*//; - next if (/^\s*$/); - - if (/^\s*(\w*)\s*\|([^\|]*)\|\s*(\w+)\s*\|\s*(\w+)?/) { - my $const = $1; - my @types = split ' ', $2; - my $result = $3; - my $funname = $4; - $funname = $const unless defined $funname; - - my $formals = ""; - my $formals2 = ""; - my $args = ""; - my $unpack = ""; - my $n = 1; - foreach my $type (@types) { - my $realType = $type; - $args .= ", "; - if ($type eq "string") { -# $args .= "(ATerm) ATmakeAppl0(ATmakeAFun((char *) e$n, 0, ATtrue))"; -# $type = "const char *"; - $type = "ATerm"; - $args .= "e$n"; - # !!! in the matcher, we should check that the - # argument is a string (i.e., a nullary application). - } elsif ($type eq "int") { - $args .= "(ATerm) ATmakeInt(e$n)"; - } elsif ($type eq "ATermList" || $type eq "ATermBlob") { - $args .= "(ATerm) e$n"; - } else { - $args .= "e$n"; - } - $formals .= ", " if $formals ne ""; - $formals .= "$type e$n"; - $formals2 .= ", "; - $formals2 .= "$type & e$n"; - my $m = $n - 1; - # !!! more checks here - if ($type eq "int") { - $unpack .= " e$n = ATgetInt((ATermInt) ATgetArgument(e, $m));\n"; - } elsif ($type eq "ATermList") { - $unpack .= " e$n = (ATermList) ATgetArgument(e, $m);\n"; - } elsif ($type eq "ATermBlob") { - $unpack .= " e$n = (ATermBlob) ATgetArgument(e, $m);\n"; - } elsif ($realType eq "string") { - $unpack .= " e$n = ATgetArgument(e, $m);\n"; - $unpack .= " if (ATgetType(e$n) != AT_APPL) return false;\n"; - } else { - $unpack .= " e$n = ATgetArgument(e, $m);\n"; - } - $n++; - } - - my $arity = scalar @types; - - print HEADER "extern AFun sym$funname;\n\n"; - - print IMPL "AFun sym$funname = 0;\n"; - - if ($arity == 0) { - print HEADER "extern ATerm const$funname;\n\n"; - print IMPL "ATerm const$funname = 0;\n"; - } - - print HEADER "static inline $result make$funname($formals) __attribute__ ((pure, nothrow));\n"; - print HEADER "static inline $result make$funname($formals) {\n"; - if ($arity == 0) { - print HEADER " return const$funname;\n"; - } - elsif ($arity <= 6) { - print HEADER " return (ATerm) ATmakeAppl$arity(sym$funname$args);\n"; - } else { - $args =~ s/^,//; - print HEADER " ATerm array[$arity] = {$args};\n"; - print HEADER " return (ATerm) ATmakeApplArray(sym$funname, array);\n"; - } - print HEADER "}\n\n"; - - print HEADER "#ifdef __cplusplus\n"; - print HEADER "static inline bool match$funname(ATerm e$formals2) {\n"; - print HEADER " if (ATgetType(e) != AT_APPL || (AFun) ATgetAFun(e) != sym$funname) return false;\n"; - print HEADER "$unpack"; - print HEADER " return true;\n"; - print HEADER "}\n"; - print HEADER "#endif\n\n\n"; - - $init .= " sym$funname = ATmakeAFun(\"$const\", $arity, ATfalse);\n"; - $init .= " ATprotectAFun(sym$funname);\n"; - if ($arity == 0) { - $init .= " const$funname = (ATerm) ATmakeAppl0(sym$funname);\n"; - $init .= " ATprotect(&const$funname);\n"; - } - } - - elsif (/^\s*(\w+)\s*=\s*(.*)$/) { - my $name = $1; - my $value = $2; - print HEADER "extern ATerm $name;\n"; - print IMPL "ATerm $name = 0;\n"; - $init .= " $name = $value;\n"; - $init .= " ATprotect(&$name);\n"; - } - - elsif (/^\s*init\s+(\w+)\s*$/) { - $initFun = $1; - } - - else { - die "bad line: `$_'"; - } -} - -print HEADER "void $initFun();\n\n"; - -print HEADER "static inline const char * aterm2String(ATerm t) {\n"; -print HEADER " return (const char *) ATgetName(ATgetAFun(t));\n"; -print HEADER "}\n\n"; - -print IMPL "\n"; -print IMPL "void $initFun() {\n"; -print IMPL "$init"; -print IMPL "}\n"; - -print HEADER "#ifdef __cplusplus\n"; -print HEADER "}\n"; -print HEADER "#endif\n\n\n"; -print IMPL "}\n"; - -close HEADER; -close IMPL; |