Author: allison
Date: Tue Feb 13 16:11:46 2007
New Revision: 16974

Modified:
   trunk/compilers/past-pm/PAST/Compiler.pir
   trunk/compilers/past-pm/POST/Compiler.pir
   trunk/examples/past/01-sub.pir
   trunk/runtime/parrot/library/Parrot/HLLCompiler.pir
   trunk/t/compilers/past-pm/hllcompiler.t

Log:
[hllcompiler]: Refactor HLLCompiler to run a configurable list of
compilation stages, rather than a single fixed list. Make it possible to
change the grammar used to compile the OST (needed for Pheme).


Modified: trunk/compilers/past-pm/PAST/Compiler.pir
==============================================================================
--- trunk/compilers/past-pm/PAST/Compiler.pir   (original)
+++ trunk/compilers/past-pm/PAST/Compiler.pir   Tue Feb 13 16:11:46 2007
@@ -37,21 +37,12 @@
     .param pmc past
     .param pmc adverbs         :slurpy :named
 
-    .local string target
-    target = adverbs['target']
-    target = downcase target
-    if target == 'past' goto return_past
-    if target == 'parse' goto return_past
-
     .local pmc postgrammar, postbuilder, post
     postgrammar = new 'POST::Grammar'
     postbuilder = postgrammar.'apply'(past)
     post = postbuilder.'get'('root')
-    $P0 = compreg 'POST'
-    .return $P0.'compile'(post, adverbs :flat :named)
+    .return (post)
 
-  return_past:
-    .return (past)
 .end
 
 =back

Modified: trunk/compilers/past-pm/POST/Compiler.pir
==============================================================================
--- trunk/compilers/past-pm/POST/Compiler.pir   (original)
+++ trunk/compilers/past-pm/POST/Compiler.pir   Tue Feb 13 16:11:46 2007
@@ -27,15 +27,10 @@
     .param pmc post
     .param pmc adverbs         :slurpy :named
 
-    .local string target
-    target = adverbs['target']
-    target = downcase target
-    if target != 'post' goto compile_post
-    .return (post)
-
-  compile_post:
     $I0 = isa post, 'POST::Sub'
     if $I0 goto with_sub
+    $S0 = typeof post
+    say $S0
     post = post.'new'('POST::Sub', post, 'name'=>'anon')
   with_sub:
     .local pmc code
@@ -44,13 +39,7 @@
     post.'pir'()
 
     code = get_hll_global ['POST'], '$!subpir'
-    if target != 'pir' goto compile_pir
     .return (code)
-
-  compile_pir:
-    $P0 = compreg 'PIR'
-    $P0 = $P0(code)
-    .return ($P0)
 .end
 
 

Modified: trunk/examples/past/01-sub.pir
==============================================================================
--- trunk/examples/past/01-sub.pir      (original)
+++ trunk/examples/past/01-sub.pir      Tue Feb 13 16:11:46 2007
@@ -3,6 +3,7 @@
 
 .sub main :main
     load_bytecode 'PAST-pm.pbc'
+    load_bytecode 'Parrot/HLLCompiler.pbc'
 
     .local pmc block
     block = new 'PAST::Block'
@@ -26,11 +27,15 @@
     $P1 = block.'push_new'('PAST::Op', $P0, 'name'=>'say')
 
     # compile to PIR and display
-    $S99 = block.'compile'('target'=>'pir')
+    .local pmc astcompiler
+    astcompiler = new 'HLLCompiler'
+    astcompiler.'removestage'('parse')
+    astcompiler.'removestage'('past')
+    $S99 = astcompiler.'compile'(block, 'target'=>'pir')
     print $S99
 
     #compile to bytecode and execute
-    $P99 = block.'compile'()
+    $P99 = astcompiler.'compile'(block)
     $P99()
 .end
 

Modified: trunk/runtime/parrot/library/Parrot/HLLCompiler.pir
==============================================================================
--- trunk/runtime/parrot/library/Parrot/HLLCompiler.pir (original)
+++ trunk/runtime/parrot/library/Parrot/HLLCompiler.pir Tue Feb 13 16:11:46 2007
@@ -17,6 +17,8 @@
     $P0 = newclass [ 'HLLCompiler' ]
     addattribute $P0, '$parsegrammar'
     addattribute $P0, '$astgrammar'
+    addattribute $P0, '$ostgrammar'
+    addattribute $P0, '@stages'
     addattribute $P0, '$!compsub'
 .end
 
@@ -35,6 +37,11 @@
 
 .include 'cclass.pasm'
 
+.sub '__init' :method
+    $P0 = split ' ', 'parse past post pir run'
+    setattribute self, '@stages', $P0
+.end
+
 .sub 'attr' :method
     .param string attrname
     .param pmc value
@@ -73,6 +80,10 @@
 
 Accessor for the C<astgrammar> attribute.
 
+=item ostgrammar([string grammar])
+
+Accessor for the 'ostgrammar' attribute.
+
 =cut
 
 .sub 'parsegrammar' :method
@@ -88,6 +99,37 @@
     .return self.'attr'('$astgrammar', value, has_value)
 .end
 
+.sub 'ostgrammar' :method
+    .param string value        :optional
+    .param int has_value       :opt_flag
+    .return self.'attr'('$ostgrammar', value, has_value)
+.end
+
+=item removestage([string stagename])
+
+Delete a stage from the compilation process queue.
+
+=cut
+
+.sub 'removestage' :method
+    .param string stagename    :optional
+    .param int has_stagename   :opt_flag
+
+    .local pmc stages, iter, newstages
+    stages = getattribute self, '@stages'
+    newstages = new .ResizableStringArray
+
+    iter = new .Iterator, stages
+  iter_loop:
+    unless iter goto iter_end
+    .local pmc current
+    current = shift iter
+    if current == stagename goto iter_loop
+      push newstages, current
+    goto iter_loop
+  iter_end:
+    setattribute self, '@stages', newstages
+.end
 
 =item compile(pmc code [, "option" => value, ... ])
 
@@ -112,13 +154,19 @@
     target = adverbs['target']
     target = downcase target
 
-    .local pmc result
-    result = self.'parse'(source, adverbs :flat :named)
-    if target == 'parse' goto have_result
-    result = self.'ast'(result, adverbs :flat :named)
-    if target == 'past' goto have_result
-    $P0 = compreg 'PAST'
-    result = $P0.'compile'(result, adverbs :flat :named)
+    .local pmc stages, result, iter
+    result = source
+    stages = getattribute self, '@stages'
+    iter = new .Iterator, stages
+  iter_loop:
+    unless iter goto iter_end
+    .local string stagename
+    stagename = shift iter
+    result = self.stagename(result, adverbs :flat :named)
+    if target == stagename goto have_result
+    goto iter_loop
+  iter_end:
+
   have_result:
     .return (result)
 .end
@@ -166,7 +214,7 @@
 
 =cut
 
-.sub 'ast' :method
+.sub 'past' :method
     .param pmc source
     .param pmc adverbs         :slurpy :named
     .local string astgrammar_name
@@ -445,6 +493,49 @@
     .return ($P0)
 .end
 
+=item ost(source [, adverbs :slurpy :named])
+
+Transform C<source> using the compiler's C<ostgrammar>
+according to any options given by C<adverbs>, and return the
+resulting ost.
+
+=cut
+
+.sub 'post' :method
+    .param pmc source
+    .param pmc adverbs         :slurpy :named
+    .local string ostgrammar_name
+    .local pmc ostgrammar, ostbuilder
+    ostgrammar_name = self.'ostgrammar'()
+    unless ostgrammar_name goto default_ostgrammar
+    $I0 = find_type ostgrammar_name
+    ostgrammar = new $I0
+    ostbuilder = ostgrammar.'apply'(source)
+    .return ostbuilder.'get'('post')
+
+  default_ostgrammar:
+    $P0 = compreg 'PAST'
+    .return $P0.'compile'(source, adverbs :flat :named)
+.end
+
+.sub 'pir' :method
+    .param pmc source
+    .param pmc adverbs         :slurpy :named
+
+    $P0 = compreg 'POST'
+    $P1 = $P0.'compile'(source, adverbs :flat :named)
+    .return ($P1)
+.end
+
+.sub 'run' :method
+    .param pmc source
+    .param pmc adverbs         :slurpy :named
+
+    $P0 = compreg 'PIR'
+    $P1 = $P0(source)
+    .return ($P1)
+.end
+
 
 =item register(string name, pmc compsub)  # DEPRECATED
 

Modified: trunk/t/compilers/past-pm/hllcompiler.t
==============================================================================
--- trunk/t/compilers/past-pm/hllcompiler.t     (original)
+++ trunk/t/compilers/past-pm/hllcompiler.t     Tue Feb 13 16:11:46 2007
@@ -38,6 +38,11 @@
     $P0.'astgrammar'('None::Grammar')
     $S1 = $P0.'astgrammar'()
     say $S1
+
+    $P0.'ostgrammar'('None::Grammar')
+    $S1 = $P0.'ostgrammar'()
+    say $S1
+
     end
 .end
 CODE
@@ -45,6 +50,7 @@
 Module
 None::Parser
 None::Grammar
+None::Grammar
 OUT
 
 pir_output_is( <<'CODE', <<'OUT', 'one complete start-to-end compiler' );

Reply via email to