Changeset 22595 for misc

Timestamp:

10/13/08 16:31:54 (3 months ago)

Author:

putter

Message:

[elfish/STD_blue] Continuing to adapt constructors.

Location:

misc/elfish/STD_blue

Files:

• IRx1_FromAST2_create.pl (modified) (13 diffs)
• STD_blue_run (modified) (3 diffs)

misc/elfish/STD_blue/IRx1_FromAST2_create.pl

@@ -13 +13 @@
 statement
 my $labels = $m<label>;
-my $result = $m<EXPR> || $m<control>;
-if $o<EXPR> && ($o<mod_loop> || $o<mod_cond>) {
+my $result = $m<EXPR> || $m<statement_control>;
+if $o<EXPR> && ($o<statement_mod_loop>.elems || $o<statement_mod_cond>.elems) {
   temp $blackboard::statement_expr = $result;
-  $result = $m<mod_loop> || $m<mod_cond>;
-  if $o<mod_condloop> {
+  $result = $m<statement_mod_loop>[0] || $m<statement_mod_cond>[0];
+  if $o<mod_condloop> { #XXX still exists?
     $blackboard::statement_expr = $result;
     $result = $m<mod_condloop>;
@@ -29 +29 @@
 
 EXPR
-if $m<infix> {
+if $o<termish> {
+  $m<termish>[0]
+}
+elsif $o<infix> {
   my $op = $m<infix><sym_name>;
   my $args = [$m<left>,$m<right>];
@@ -39 +42 @@
   }
 }
+elsif $o<chain> {
+  my $op = $o<chain>[1]<sym_name>;
+  my $args = [$m<chain>[0],$m<chain>[2]];
+  Apply.newp("infix:"~$op,Capture.newp1($args))
+}
+elsif $o<list> {
+  my $op = $o<delims>[0]<sym_name>;
+  my $args = $m<list>;
+  Apply.newp("infix:"~$op,Capture.newp1($args))
+}
 else {
   temp $blackboard::expect_term_base = $m<noun>;
@@ -99 +112 @@
 $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>
 
+
+desigilname
+$m<longname>
+
+deflongname
+$m<name>
+
 longname
 $m<name>
@@ -130 +150 @@
 my $args = $m<args><semilist>;
 if not($args) && $o<args><arglist>[0]<EXPR> {
-  $args = [ irbuild_ir($o<args><arglist>[0]<EXPR>) ];
+  $args = [ ir($o<args><arglist>[0]<EXPR>) ];
 }
 Apply.newp($m<identifier>,Capture.newp1($args||[]))
@@ -159 +179 @@
 my $nibs = $m<nibble><nibbles>;
 my $args = $nibs.map(sub($x){if $x.WHAT eq 'Str' {Buf.newp($x);} else {$x}});
-Apply.newp('infix:~',Capture.newp1($args||[]))
+if $args.elems < 2 { $args.push(Buf.newp("")) }
+my $tmp = $args.shift;
+for $args {
+  $tmp = Apply.newp('infix:~',Capture.newp1([$tmp,$_]))
+}
+$tmp;
 
 nibbles:\
 my $which = $m<item><sym_name>;
 if $which eq 'n' { "\n" }
-if $which eq 't' { "\t" }
+elsif $which eq 't' { "\t" }
 else { $which }
+
+nibbles
+$m<variable>
 
 
@@ -198 +226 @@
 
 variable
-my $tw = $m<twigil>;
-if $o<postcircumfix> {
+my $tw = $m<twigil>[0];
+if $o<postcircumfix>.elems {
   if $tw eq "." {
     my $slf = Apply.newp('self',Capture.newp1([]));
@@ -231 +259 @@
 
 statement_control:for
-For.newp($m<EXPR>,$m<xblock>)
+For.newp($m<xblock><EXPR>,$m<xblock>)
 
 statement_mod_loop:for
@@ -259 +287 @@
 
 statement_control:if
+my $if_expr = $m<xblock><EXPR>;
+my $if_block = $m<xblock><pblock>;
 my $els = $m<else>;
 if $els { $els = $els[0] }
-Cond.newp([[$m<if_expr>,$m<if_block>]].push($m<elsif>.flatten),$els,undef)
+Cond.newp([[$if_expr,$if_block]].push($m<elsif>.flatten),$els,undef)
 
 elsif
@@ -315 +345 @@
 
 pblock
-if $o<signature> {
-  SubDecl.newp(undef,undef,undef,undef,$m<signature>,undef,$m<block>)
+if $o<signature>.elems {
+  SubDecl.newp(undef,undef,undef,undef,$m<signature>[0],undef,$m<block>)
 } else {
   $m<block>
@@ -327 +357 @@
 $m<pblock>
 
-plurality_declarator:multi
+multi_declarator:multi
 temp $blackboard::plurality = 'multi';
-$m<pluralized> || $m<routine_def>
-
-routine_declarator:routine_def
-my $scope = $blackboard::scope; temp $blackboard::scope;
+$m<declarator>
+
+routine_declarator:sub
+$m<routine_def>
+
+routine_declarator:method
+$m<method_def>
+
+method_def
 my $plurality = $blackboard::plurality; temp $blackboard::plurality;
-my $ident = "";
-if $o<ident> { $ident = $m<ident>  };
-if ($o<ident> && not($scope)) { $scope = "our" };
-my $sig = Signature.newp([],undef);
-if $m<multisig> { $sig = $m<multisig>.[0] };
-SubDecl.newp($scope,undef,$plurality,$ident,$sig,$m<trait>,$m<block>)
-
-# routine_def is the same as routine_declarator:routine_def
-# This is a workaround for STD.pm not recognizing  multi f(){} .
+my $multisig = $m<multisig>;
+if not($multisig) { $multisig = [Signature.newp([],undef)]; }
+MethodDecl.newp(undef,undef,$plurality,$m<longname>,$multisig.[0],maybe($m<trait>),$m<block>,undef,undef)
+
 routine_def
 my $scope = $blackboard::scope; temp $blackboard::scope;
 my $plurality = $blackboard::plurality; temp $blackboard::plurality;
 my $ident = "";
-if $o<ident> { $ident = $m<ident>  };
-if ($o<ident> && not($scope)) { $scope = "our" };
+if $o<deflongname>.elems { $ident = $m<deflongname>[0]  };
+if ($ident && not($scope)) { $scope = "our" };
 my $sig = Signature.newp([],undef);
-if $m<multisig> { $sig = $m<multisig>.[0] };
-SubDecl.newp($scope,undef,$plurality,$ident,$sig,$m<trait>,$m<block>)
-
-routine_declarator:method_def
-my $plurality = $blackboard::plurality; temp $blackboard::plurality;
-my $multisig = $m<multisig>;
-if not($multisig) { $multisig = [Signature.newp([],undef)]; }
-MethodDecl.newp(undef,undef,$plurality,$m<ident>,$multisig.[0],$m<trait>,$m<block>,undef,undef)
+if $o<multisig> { $sig = $m<multisig>.[0] };
+SubDecl.newp($scope,undef,$plurality,$ident,$sig,maybe($m<trait>),$m<block>)
+
+multisig
+$m<signature>[0]
 
 signature
-Signature.newp($m<parsep>,undef)
+Signature.newp($m<parameter>,undef)
 
 parameter
-Parameter.newp($m<type_constraint>,$m<quantchar>,$m<param_var>,undef,undef,undef,undef)
+my $var = $m<param_var>;
+my $quantchar;
+if $o<slurp> {
+  $var = $m<slurp><param_var>;
+  $quantchar = '*';
+}
+my $type_constraint = $m<type_constraint>;
+#X gimme5 is emitting two copies of the constraint.
+if $type_constraint && $type_constraint.elems == 2 { $type_constraint.pop }
+Parameter.newp($type_constraint,$quantchar,$var,undef,undef,undef,undef)
 
 param_var
-ParamVar.newp($m<sigil>,$m<twigil>,$m<ident>)
+ParamVar.newp($m<sigil>,$m<twigil>[0],$m<identifier>[0])
+
+type_constraint
+$m<fulltypename>
+
+fulltypename
+$m<typename>[0]
+
+typename
+$m<longname>
+
 
 capture
@@ -450 +496 @@
 
 package_def
-PackageDecl.newp(undef,undef,$blackboard::package_declarator,$m<module_name>.[0],$m<traits>,$m<block>)
-
-fulltypename
-$m<typename>.join("::")
-
-typename
-*text* # $m<name>
-
-trait_verb:is
-Trait.newp('is',$m<ident>)
-
-trait_verb:does
-Trait.newp('does',$m<role_name>)
+PackageDecl.newp(undef,undef,$blackboard::package_declarator,$m<module_name>.[0],maybe($m<trait>),$m<block>)
+
+trait
+$m<trait_auxiliary>
+
+trait_auxiliary:is
+Trait.newp('is',$m<longname>)
+
+trait_auxiliary:does
+Trait.newp('does',$m<module_name>)
 
 
@@ -632 +675 @@
         $x.make_ir_from_Match_tree()
       };
+      sub maybe ($x) {
+        if $x.WHAT eq "Array" && $x.elems == 0 { undef }
+        else { $x }
+      }
 
   END

misc/elfish/STD_blue/STD_blue_run

@@ -149 +149 @@
     if($seen{$o}++ > $max_repetition) { return "LOOP:$o"->to_dump0 }
     my $rule = $category;
-    if($rule =~ /\A(chain|list|arg|left|right)\z/) { $rule = 'EXPR' }
+    if($rule =~ /\A(chain|list|arg|left|right|termish)\z/) { $rule = 'EXPR' }
     my $sym = $o->{sym};
     if($sym) {
@@ -168 +168 @@
         my $v = $o->{$_};
         local $category = $_;
-        my $vs = $v->to_dump0;
+        my $vs = defined($v) ? $v->to_dump0 : 'undef';
         "\n $_ => $vs,"
       }
@@ -190 +190 @@
   sub to_dump0 {
     my($o)=@_;
-    $o =~ s/([\\'\$\@\%])/\\$1/g;
+    $o =~ s/([\\'])/\\$1/g;
     "'".$o."'";
   }