Changeset 22964 for misc

Timestamp:

11/10/08 23:30:30 (2 months ago)

Author:

putter

Message:

[elfish/STD_blue] Began adaptation to current STD.pm/gimme5 (r22962).
Progress: CommandLine?.pm is compiled correctly (1 diff: not() is parsed as prefix:not()).

Location:

misc/elfish/STD_blue

Files:

• IRx1_FromAST2_create.pl (modified) (10 diffs)
• Makefile (modified) (1 diff)
• STD_blue_run (modified) (4 diffs)

misc/elfish/STD_blue/IRx1_FromAST2_create.pl

@@ -28 +28 @@
 }
 
+nulltermish
+$m<termish>[0]
+
+termish
+my $noun = $m<noun>;
+temp $blackboard::expect_term_base = $noun;
+my $ops = [];
+if $o<PRE> { $ops.push($o<PRE>.flatten) };
+if $o<POST> { $ops.push($o<POST>.flatten) };
+for $ops {
+  $blackboard::expect_term_base = ir($_)
+}
+$blackboard::expect_term_base
+
 EXPR
-if $o<termish> {
-  $m<termish>[0]
-}
-elsif $o<arg> {
-  $m<arg>
-}
-elsif $o<infix> {
+if $o<infix> {
   my $op = $m<infix><sym_name>;
   my $args = [$m<left>,$m<right>];
@@ -51 +59 @@
   }
 }
+elsif $o<prefix> {
+  my $op = $m<prefix><sym_name>;
+  Apply.newp("prefix:"~$op,Capture.newp1([$m<arg>]))
+}
 elsif $o<chain> {
   my $chain = $m<chain>;
@@ -62 +74 @@
   Apply.newp("infix:"~$op,Capture.newp1($args))
 }
+elsif $o<value> {
+  $m<value>
+}
 elsif $o<noun> {
-  temp $blackboard::expect_term_base = $m<noun>;
-  my $ops = [];
-  if $o<pre>  {
-    my $pre = $o<pre>;
-    my $kludge;
-    $pre = $pre.map(sub($x){
-      if $x<sym_name> && $x<sym_name> eq 'temp' {
-        my $scope = 'temp';
-        my $typenames = undef;
-        my $variable = $m<noun>;
-        my $traits = undef;
-        my $default_value = undef;
-        $kludge = VarDecl.newp($scope,$typenames,undef,$variable,undef,$traits,'=',$m<default_value>)
-      }
-      $x;
-    });
-    if $kludge { return $kludge }
-    $ops.push($pre.flatten)
-  };
-  if $o<post> { $ops.push($o<post>.flatten) };
-  for $ops {
-    $blackboard::expect_term_base = ir($_)
-  }
-  $blackboard::expect_term_base
-}
-elsif $o<left> { #XX temp hack for vanished 'infix'.
-  my $args = [$m<left>,$m<right>];
-  my $op = "=";
-  if $op eq '=' && $args[0].WHAT.re_matchp('VarDecl') {
-    # To simplify elf_h STD_red vs STD_blue diffs.
-    $args[0].default_expr = $args[1];
-    $args[0];
-  } else {
-    Apply.newp("infix:"~$op,Capture.newp1($args))
-  }
+  $m<noun>
+}
+elsif $o<dotty> {
+  temp $blackboard::expect_term_base = $m<arg>;
+  $m<dotty>;
+}
+elsif $o<postop> {
+  temp $blackboard::expect_term_base = $m<arg>;
+  $m<postop>;
 }
 else { die "Didn't understand an EXPR node" }
 
-pre
+PRE
 $m<prefix>
 
-post
+POST
 $m<postop> || $m<dotty>
 
@@ -114 +103 @@
 my $name = "prefix:"~$op;
 if $op.re_matchp('\A\w+\z') { $name = $op }
-Apply.newp($name,Capture.newp1([$blackboard::expect_term_base]))
+if $op eq 'temp' {
+  my $scope = 'temp';
+  my $typenames = undef;
+  my $variable = $blackboard::expect_term_base;
+  my $traits = undef;
+  my $default_value = undef;
+  VarDecl.newp($scope,$typenames,undef,$variable,undef,$traits,'=',$default_value)
+} else {
+  Apply.newp($name,Capture.newp1([$blackboard::expect_term_base]))
+}
 
 postfix
@@ -123 +121 @@
 my $name = $m<sym_name>;
 my $ident = "postcircumfix:"~$name;
-my $args = $m<semilist>;
+my $args = $m<semilist> || $m<nibble>;
 if $args && ($args.WHAT ne 'Array')  { $args = [$args] }
 Call.newp($blackboard::expect_term_base,$ident,Capture.newp1($args||[]))
@@ -132 +130 @@
 if $args && ($args.WHAT ne 'Array')  { $args = [$args] }
 Apply.newp("circumfix:"~$op,Capture.newp1($args||[]))
+
+infix
+my $op = $m<sym_name>;
+$op;
 
 semilist
@@ -159 +161 @@
 $m<fatarrow> || $m<variable> || $m<package_declarator> || $m<scope_declarator> || $m<multi_declarator> || $m<routine_declarator> || $m<regex_declarator> || $m<type_declarator> || $m<circumfix> || $m<dotty> || $m<value> || $m<capterm> || $m<sigterm> || $m<term> || $m<statement_prefi> || $m<colonpair>
 
+infixish
+$m<colonpair> || $m<infix> || $m<infix_prefix_meta_operator> || $m<infix_circumfix_meta_operator> || $m<infix>
 
 desigilname
@@ -188 +192 @@
 
 integer
+NumInt.newp(*text*,10)
+
+dec_number
 NumInt.newp(*text*,10)
 
@@ -348 +355 @@
 Cond.newp([[$if_expr,$if_block]].push($elsif.flatten),$els,undef)
 
-elsif
+statement_control__S_036if_elsif
 [$m<xblock><EXPR>,$m<xblock><pblock>]
 
@@ -494 +501 @@
 else { die "capture AST form not recognized" }
 
+nibbler
+#XXX I've sooo no idea.
+$m<nibbles>[0]
+
 colonpair
-*1*
+my $v = $m<v>;
+if $o<v><nibble> { #XXX :x<2> bypass postcircumfix:< >.
+  $v = $o<v><nibble><nibbles>[0];
+  $v = Buf.newp($v)
+}
+my $k = $m<k>; # or $m<identifier> ?
+Pair.newp($k,$v)
 
 colonpair__false

misc/elfish/STD_blue/Makefile

@@ -1 +1 @@
 
-elfx::
+ELF=../../elf/elf_h
+ELFDIR=../../elf/elf_h_src
+TMP=deleteme
+
+elfx:: have_parser_cache
         ./IRx1_FromAST2_create.pl
         ../../elf/elf_h -x -o ./elfx -I ../../elf/elf_h_src -e 'use Elf_wo_main' IRx1_FromAST2.pm Parser2.pm -e elf_main
+
+
+check: have_parser_cache
+        # Remove STD.pm/gimme5 cruft.
+        -rm -rf lex
+        # Remove remains of previous runs.
+        -mkdir ${TMP}
+        -rm ${TMP}/[a]*
+        # Create a STD_blue based elf.
+        make elfx
+        # Use it to compile a normal elf.
+        ./elfx -I ${ELFDIR} -x -o ${TMP}/a1 ${ELFDIR}/Elf.pm
+        # Test the normal elf by using it to self-compile.
+        ./elfx -I ${ELFDIR} -x -o ${TMP}/a2 ${ELFDIR}/Elf.pm
+        # Create a reference elf.
+        ${ELF} -I ${ELFDIR} -x -o ${TMP}/a0 ${ELFDIR}/Elf.pm
+        # Were they the same?
+        diff ${TMP}/a0 ${TMP}/a2
+        @echo ok
+
+
+have_parser_cache:
+        @perl -e 'if(!-d shift){print STDERR "\nDefine STD_RED_CACHEDIR for faster compiles.\n\n";}' $(STD_RED_CACHEDIR)

misc/elfish/STD_blue/STD_blue_run

@@ -92 +92 @@
     #use YAML::XS;
     #print Dump($r);
-    #use Data::Dumper;
-    #print Dumper($r);
-    use DumpMatch; #src/perl6/STD5_dump_match
-    print dump_match("comp_unit",$r,{vertical=>1});
+    use Data::Dumper;
+    print Dumper($r);
+#    use DumpMatch; #src/perl6/STD5_dump_match
+#    print dump_match("comp_unit",$r,{vertical=>1});
   } 
   elsif($format eq 'p5a') {
+    $main::whole_file = $code;
+    $main::whole_file .= " "; # -e '3' dump includes _pos's of 2
     print out($cache_file,$r->to_dump0);
   }
@@ -141 +143 @@
     else { die "bogus sym: $sym\n" }
   }
-  our $category = 'comp_unit';
   our %seen;
   our $max_repetition = 20;
@@ -148 +149 @@
     local $seen{$o} = $seen{$o};
     if($seen{$o}++ > $max_repetition) { return "LOOP:$o"->to_dump0 }
-    my $rule = $category;
-    if($rule =~ /\A(chain|list|arg|left|right|termish)\z/) { $rule = 'EXPR' }
+
+    my $rule = $o->{_reduced} || die;
+
+    my $f = $o->{_from};
+    my $t = $o->{_pos};
+    my $str = substr($main::whole_file,$f,$t-$f);
+
     my $sym = $o->{sym};
+    if($sym && $sym eq ';') {
+      # Workaround bug in STD/gimme5 r22962.
+      # -e 'last;' -> term:sym<;> instead of term:sym<last>.
+      $sym = $str;
+    }
     if($sym) {
       my $normalized = $o->condition_sym($sym);
       $o->{sym_name} = $normalized;
-      $rule .= ":".$normalized if $sym ne $rule && $rule ne 'EXPR';
+      $rule .= ":".$normalized if ($sym ne $rule &&
+                                   $rule ne 'EXPR' &&
+                                   $rule ne 'infixish');
     }
     my $rule_str = $rule->to_dump0;
-    my $f = $o->{_from};
-    my $t = $o->{_to};
-    my $whole_file = ${$o->{_orig}};
-    my $str = substr($whole_file,$f,$t-$f);
     my $s = $str->to_dump0;
     my $h = join("",map{
@@ -167 +176 @@
       else {
         my $v = $o->{$_};
-        local $category = $_;
         my $vs = defined($v) ? $v->to_dump0 : 'undef';
         "\n $_ => $vs,"