Changeset 21193

Timestamp:

07/03/08 22:05:08 (3 months ago)

Author:

pmurias

Message:

[sm0p] initial version of the new grammar

Location:

misc/sm0p

Files:

• sm0p.pm (modified) (2 diffs)
• sm0p_with_actions (modified) (1 diff)
• strip_out_actions (modified) (2 diffs)

misc/sm0p/sm0p.pm

@@ -1 +1 @@
 grammar sm0p;
 token frame {
-    <ws> <identifier> <ws> '=' <ws> 'q:sm0p' <ws> '{' <ws> <node>+ <ws> '}' <ws> ';'
+    <ws> <identifier>  <ws> '=' <ws> 'q:sm0p' <ws> '{' <ws> <nodes> <ws> '}' <ws> ';'?
     { make $<identifier> ~ ' = SMOP_DISPATCH(interpreter, '
       ~ 'SMOP__SLIME__Frame, SMOP__ID__new, SMOP__NATIVE__capture_create('
       ~ 'interpreter, SMOP__SLIME__Frame, (SMOP__Object*[]){ '
-      ~ ($$<node>).join(',') ~ ' }, NULL)); ' }
-};
+      ~ $<nodes> ~ ' }, NULL)); ' }
+}
+
+token nodes {
+    <node>*
+    { make $<node>.join(', ') }
+}
 
 token node {
+    <node_empty> { make $<node_empty> ~ '' }
+    || <node_result> { make $<node_result> ~ '' }
+    || <node_capturized> { make $<node_capturized> ~ '' }
+    || <node_full> { make $<node_full> ~ '' }
+}
+
+token node_empty {
+    # <ws>
+  ';'
+    { make 'SMOP_DISPATCH(interpreter, SMOP__SLIME__Node, SMOP__ID__new, '
+      ~ ' SMOP__NATIVE__capture_create(interpreter, SMOP__SLIME__Node, NULL, NULL))' }
+}
+
+token node_full {
     <ws> <responder> '.' <identifier> '('
-    [ <ws> <invocant> <ws> ':' ]? <ws> <positional> <ws> <named> <ws> ')' ';'
+    [ <invocant>||'' ] <ws> <named> <ws> <positional> <ws> ')' <ws> ';' <ws>
     { make 'SMOP_DISPATCH(interpreter, SMOP__SLIME__Node, SMOP__ID__new, '
       ~ ' SMOP__NATIVE__capture_create(interpreter, SMOP__SLIME__Node, NULL, (SMOP__Object*[]){'
-      ~ ' SMOP__ID__responder, SMOP_RI(' ~ $<responder> ~ '), '
-      ~ ' SMOP__ID__identifier, ' ~ $<identifier> ~ ', '
+      ~ ' SMOP__ID__responder, SMOP_REFERENCE(interpreter,(SMOP__Object*)SMOP_RI(' ~ $<responder> ~ ')), '
+      ~ ' SMOP__ID__identifier, SMOP_REFERENCE(interpreter,' ~ $<identifier> ~ '), '
       ~ ' SMOP__ID__capture, SMOP__NATIVE__capture_create(interpreter, '
-      ~ ($<invocant> ?? $<invocant> !! $<responder>) ~ ', '~ $<positional> ~', '~ $<named> ~') '
-      ~ ',NULL }))' }
-  | <ws> <identifier> <ws> ';'
+      ~ 'SMOP_REFERENCE(interpreter,' ~ ($<invocant> ?? $<invocant> !! $<responder>) ~ '), '~ $<positional> ~', '~ $<named> ~') '
+      ~ ' , NULL  }))' }
+}
+
+token node_capturized {
+    <ws> <responder> '.' <identifier> '('
+    <ws> '|' <identifier2> <ws> ')' <ws> ';' <ws>
     { make 'SMOP_DISPATCH(interpreter, SMOP__SLIME__Node, SMOP__ID__new, '
       ~ ' SMOP__NATIVE__capture_create(interpreter, SMOP__SLIME__Node, NULL, (SMOP__Object*[]){'
-      ~ ' SMOP__ID__result, ' ~ $<identifier>
-      ~ ',NULL }))' }
-  | <ws> ';'
+      ~ ' SMOP__ID__responder, SMOP_REFERENCE(interpreter,(SMOP__Object*)SMOP_RI(' ~ $<responder> ~ ')), '
+      ~ ' SMOP__ID__identifier, SMOP_REFERENCE(interpreter,' ~ $<identifier> ~ '), '
+      ~ ' SMOP__ID__capture, ' ~ $<identifier2> 
+      ~ ' , NULL  }))' }
+}
+
+token node_result {
+    <ws> <identifier> <ws> ';'
     { make 'SMOP_DISPATCH(interpreter, SMOP__SLIME__Node, SMOP__ID__new, '
-      ~ ' SMOP__NATIVE__capture_create(interpreter, SMOP__SLIME__Node, NULL, NULL))' }
-};
+      ~ ' SMOP__NATIVE__capture_create(interpreter, SMOP__SLIME__Node, NULL, (SMOP__Object*[]){'
+      ~ ' SMOP__ID__result, SMOP_REFERENCE(interpreter,' ~ $<identifier> ~ ')'
+      ~ ' , NULL}))' }
+}
 
 token invocant {
-    <identifier>
-};
+    <ws> <identifier> <ws> ':' <ws>
+    { make $<identifier> ~ '' }
+}
 
 token responder {
     <identifier>
-};
+    { make $<identifier> ~ '' }
+}
 
 token positional {
     <positionals>
-    { make '(SMOP__Object*[]){' ~ ($$<positionals>).join(',') ~ ',NULL}'  }
-  | { make 'NULL' }
-};
+    { make '(SMOP__Object*[]){' ~ $<positionals> ~ '}'  }
+ ||{ make ' NULL' }
+}
 
 token positionals {
     <identifier>
     [
-    |   <ws> \, <ws> <positionals>
-        { make [ $$<identifier>, ( $$<positionals> ).values ] }
-    |   <ws> [ \, <ws> | '' ]
-        { make [ $$<identifier> ] }
+   ||  <ws> \, <ws> <positionals>
+        { make $<identifier> ~ ', ' ~ $<positionals>  }
+   ||  <ws>
+        { make $<identifier> ~ ', NULL' }
     ]
-|   { make [ ] }
 }
 
 token named {
     <pairs>
-    { make '(SMOP__Object*[]){' ~ ($$<pairs>).join(',') ~ ',NULL}'  }
-  | { make 'NULL' }
-};
+    { make '(SMOP__Object*[]){' ~ $<pairs> ~ '}'  }
+ ||{ make ' NULL' }
+}
 
 token pairs {
     <pair>
     [
-    |   <ws> \, <ws> <pairs>
-        { make [ $$<pair>, ( $$<pairs> ).values ] }
-    |   <ws> [ \, <ws> | '' ]
-        { make [ $$<pair> ] }
+        <ws> \, <ws> <pairs>
+        { make $<pair> ~ ', ' ~ $<pairs> }
+   ||  <ws> [ \, <ws> | '' ]
+        { make $<pair> ~ ', NULL' }
     ]
-|   { make [ ] }
 }
 
@@ -73 +103 @@
     <identifier> <ws> '=>' <ws> <identifier2>
     { make $<identifier> ~ ', ' ~ $<identifier2> }
-};
+}
 
 token identifier2 {
-    <identifier>
-};
+    <identifier> { make $<identifier> ~ '' }
+}
 
 token identifier {
-    '$' <name> { make $<name> }
-  | <idconst> { make $<idconst> }
-  | <name> { make $<name> }
-};
+    <capturize> { make $<capturize> ~ '' }
+ ||'$' <name> { make $<name> ~ '' }
+ ||<idconst> { make $<idconst> ~ ''}
+ ||<name> { make $<name> ~ '' }
+ ||<nativeint> { make $<nativeint> ~ '' }
+}
 
 token idconst {
-    new { make 'SMOP__ID__new' }
-  | lexical { make 'SMOP__ID__lexical' }
-};
+  <idconst_list> { make 'SMOP__ID__' ~ $/ ~ '' }
+}
+
+token idconst_list {(new|lexical|back|capture|continuation|continues|copy|current|debug|drop|DESTROYALL|eval|forget|free|goto|has_next|identifier|jail|lexical|loop|move_capturize|move_identifier|move_responder|new|next|past|push|responder|result|setr|outer)}
 
 token name {
-    <.alpha> [ <.alpha> | <.digit> ]+
-};
+    <nameP5>
+}
 
-token ws {
-    [ \s | \n  | '#' .+? \n ]*
-};
+token ws  {\s*} 
 
-token digit {
-    <[0-9]>
-};
+token capturize {
+    <ws> SMOP__SLIME__Capturize '.'  new  '(' <ws>
+    <cint1> <ws> ',' <ws> <cintlist1> <ws> ',' <ws>
+    <cintlist2> <ws> ',' <ws> <cint2> ')'
+    { make 'SMOP__SLIME__Capturize_create(' ~ $<cint1> ~ ','
+      ~ $<cintlist1> ~ ',' ~ $<cintlist2> ~ ','
+      ~ $<cint2> ~ ')' }
+}
+
+token cint1 { <cint> { make $<cint> ~ '' } }
+token cint2 { <cint> { make $<cint> ~ '' } }
+token cint {
+    <digitsP5> { make $/ ~ '' }
+}
+
+token cintlist1 { <cintlist> { make $<cintlist> ~ '' } }
+token cintlist2 { <cintlist> { make $<cintlist> ~ '' } }
+token cintlist {
+    '('
+    [ <cintlistbody> ')' {make '(int[]){ '~ $<cintlistbody> ~ ' }' }
+   ||')' {make 'NULL'} ] 
+  ||'' {make 'NULL'}
+}
+
+token cintlistbody {
+    <ws> <cint> <ws>
+[
+     ',' <ws> <cintlistbody> <ws>
+     { make $<cint> ~ ', ' ~ $<cintlistbody> }
+   ||'' { make $<cint> ~ ', 0 '}
+    ]
+}
+
+token nativeint {
+    <digitsP5> { make 'SMOP__NATIVE__int_create(' ~ $/ ~ ')' }
+}
+
+token nativeint_list {
+    '(' <nativeint_list_body>
+    ')' {make '(SMOP__Object*[]){ '~ $<nativeint_list_body> ~ ' }' }
+  ||'' {make 'NULL'}
+}
+
+token nativeint_list_body {
+    <ws> <nativeint> <ws>
+    [
+     ',' <ws> <nativeint_list_body> <ws>
+     { make $<nativeint> ~ ', ' ~ $<nativeint_list_body> }
+   ||'' { make $<nativeint> ~ ', NULL '}
+    ]
+}
+
+token nameP5 {<[a-zA-Z_]>\w*}
+#token nameP5 {<[a-zA-Z_]>\w*}
+token digitsP5 {\d+}

misc/sm0p/sm0p_with_actions

@@ -54 +54 @@
     exit;
 } elsif ($vertical || $horizontal) {
-    print dump_match($what=>$r,{actions=>sub {@_},vertical=>$vertical}),"\n";
+    print dump_match($what=>$r,{actions=>sub {"@_"},vertical=>$vertical}),"\n";
 }
 print $r->item,"\n";

misc/sm0p/strip_out_actions

@@ -27 +27 @@
     my $body = $3;
     my $end = $4;
-    $body =~ s/(?<!')\{ ($block) \}/push(@blocks,["${name}__sm0p_$nr",$1]);'{*}' . "  #= sm0p_" . $nr++/egx;
+    $body =~ s/(?<!')\{ ($block) \}/push(@blocks,["${name}__sm0p_$nr",$1]);'{*}' . "  #= sm0p_" . $nr++ . "\n"
+/egx;
     $start.$body.$end;
 ]exg;
@@ -43 +44 @@
 }
 sub adapter {
-    local $_;
     if (ref $_[0] eq 'ARRAY') {
         [map {$_->item} @{$_[0]}];
+    } elsif ($_[0]) {
+        $_[0]->item;
     } else {
-        $_[0]->item;
+        $_[0]
     }
 }