perl.cvs.parrot
[Top] [All Lists]

[svn:parrot] r24499 - in trunk/languages/eclectus: . t

Subject: [svn:parrot] r24499 - in trunk/languages/eclectus: . t
From:
Date: Thu, 3 Jan 2008 13:08:14 -0800 PST
Newsgroups: perl.cvs.parrot

Author: bernhard
Date: Thu Jan  3 13:08:14 2008
New Revision: 24499

Modified:
   trunk/languages/eclectus/compiler.scm
   trunk/languages/eclectus/t/binary_primitives.t

Log:
[Eclectus]
Return that "val_x" from deeper down.
Find error in tests along the way.


Modified: trunk/languages/eclectus/compiler.scm
==============================================================================
--- trunk/languages/eclectus/compiler.scm       (original)
+++ trunk/languages/eclectus/compiler.scm       Thu Jan  3 13:08:14 2008
@@ -506,20 +506,22 @@
     (emit "    val_false = val_x")))
 
 (define emit-function-footer
-  (lambda ()
+  (lambda (reg)
     (emit "
-            .return( val_x )
+            .return( ~a )
           .end
-          ")))
+          " reg)))
 
 (define emit-primcall
   (lambda (expr)
     (let ([prim (car expr)] [args (cdr expr)])
-      (apply (primitive-emitter prim) (gen-unique-id) args))))
+      (apply (primitive-emitter prim) (gen-unique-id) args))
+    "val_x"))
 
 (define emit-immediate
   (lambda (expr)
-    (emit (immediate-rep expr))))
+    (emit (immediate-rep expr))
+    "val_x"))
 
 (define bindings
   (lambda (x)
@@ -544,8 +546,7 @@
                reg_let_var_~a = new 'PAST::Var'
                reg_let_var_~a.init( 'name' => '~a', 'scope' => 'lexical', 
'viviself' => 'Undef', 'isdecl' => 1 )
                " uid uid (caar binds))
-         (emit-expr (cadar binds))
-         (emit "reg_let_val_~a = ~a" uid (emit-expr body))
+         (emit "reg_let_val_~a = ~a" uid (emit-expr (cadar binds)))
          (emit "
                reg_let_copy_~a = new 'PAST::Op'
                reg_let_copy_~a.init( reg_let_var_~a, reg_let_val_~a,  
'pasttype' => 'copy', 'lvalue' => 1 )
@@ -554,7 +555,8 @@
          (emit "
                val_x = new 'PAST::Stmts'
                val_x.init( reg_let_copy_~a, reg_let_body_~a )
-               " uid uid)))))
+               " uid uid)))
+       "val_x"))
 
 (define emit-if
   (lambda (expr uid)
@@ -565,7 +567,8 @@
     (emit "
           val_x = new 'PAST::Op'
           val_x.init( reg_if_test_~a, reg_if_conseq_~a, reg_if_altern_~a, 
'pasttype' => 'if'  )
-          " uid uid uid)))
+          " uid uid uid)
+    "val_x"))
  
 ; emir PIR for an expression
 (define emit-expr
@@ -577,8 +580,7 @@
       [(let? x)       (emit-let (bindings x) (body x) (gen-unique-id))]
       [(if? x)        (emit-if x (gen-unique-id))]
       [(primcall? x)  (emit-primcall x)]
-    )
-    "val_x")) 
+    ))) 
 
 ; transverse the program and rewrite
 ; "and" can be supported by transformation before compiling
@@ -613,5 +615,4 @@
     (emit-driver)
     (emit-builtins)
     (emit-function-header "scheme_entry")
-    (emit-expr (transform-and-or program)) 
-    (emit-function-footer)))
+    (emit-function-footer (emit-expr (transform-and-or program)))))

Modified: trunk/languages/eclectus/t/binary_primitives.t
==============================================================================
--- trunk/languages/eclectus/t/binary_primitives.t      (original)
+++ trunk/languages/eclectus/t/binary_primitives.t      Thu Jan  3 13:08:14 2008
@@ -64,8 +64,8 @@
   [(fx< -123456789 123456789 )                  => "#t\n" ]
   [(fx< 123456789 -123456789 )                  => "#f\n" ]
   [(fx< 123456789 (fxadd1 123456789))           => "#t\n" ]
-  [(fx< -123456789 (fxadd1 -123456790 ))        => "#f\n" ]
-  [(fx< -123456789 (fxadd -123456791 2 ))       => "#f\n" ]
+  [(fx< -123456789 (fxadd1 -123456790))         => "#f\n" ]
+  [(fx< -123456789 (fx+ -123456791 2))          => "#f\n" ]
 
   [(fx<= 0 0 )                                   => "#t\n" ]
   [(fx<= -0 0 )                                  => "#t\n" ]
@@ -77,8 +77,8 @@
   [(fx<= -123456789 123456789 )                  => "#t\n" ]
   [(fx<= 123456789 -123456789 )                  => "#f\n" ]
   [(fx<= 123456789 (fxadd1 123456789))           => "#t\n" ]
-  [(fx<= -123456789 (fxadd1 -123456790 ))        => "#t\n" ]
-  [(fx<= -123456789 (fxadd -123456791 2 ))       => "#t\n" ]
+  [(fx<= -123456789 (fxadd1 -123456790))         => "#t\n" ]
+  [(fx<= -123456789 (fx+ -123456791 2))          => "#t\n" ]
 
   [(fx= 0 0 )                                   => "#t\n" ]
   [(fx= -0 0 )                                  => "#t\n" ]
@@ -90,8 +90,8 @@
   [(fx= -123456789 123456789 )                  => "#f\n" ]
   [(fx= 123456789 -123456789 )                  => "#f\n" ]
   [(fx= 123456789 (fxadd1 123456789))           => "#f\n" ]
-  [(fx= -123456789 (fxadd1 -123456790 ))        => "#t\n" ]
-  [(fx= -123456789 (fxadd -123456791 2 ))       => "#t\n" ]
+  [(fx= -123456789 (fxadd1 -123456790))         => "#t\n" ]
+  [(fx= -123456789 (fx+ -123456791 2))          => "#t\n" ]
 
   [(fx>= 0 0 )                                  => "#t\n" ]
   [(fx>= -0 0 )                                 => "#t\n" ]
@@ -103,8 +103,8 @@
   [(fx>= -123456789 123456789 )                 => "#f\n" ]
   [(fx>= 123456789 -123456789 )                 => "#t\n" ]
   [(fx>= 123456789 (fxadd1 123456789))          => "#f\n" ]
-  [(fx>= -123456789 (fxadd1 -123456790 ))       => "#t\n" ]
-  [(fx>= -123456789 (fxadd -123456791 2 ))      => "#t\n" ]
+  [(fx>= -123456789 (fxadd1 -123456790))        => "#t\n" ]
+  [(fx>= -123456789 (fx+ -123456791 2))         => "#t\n" ]
 
   [(fx> 0 0 )                                    => "#f\n" ]
   [(fx> -0 0 )                                   => "#f\n" ]
@@ -116,8 +116,8 @@
   [(fx> -123456789 123456789 )                   => "#f\n" ]
   [(fx> 123456789 -123456789 )                   => "#t\n" ]
   [(fx> 123456789 (fxadd1 123456789))            => "#f\n" ]
-  [(fx> -123456789 (fxadd1 -123456790 ))         => "#f\n" ]
-  [(fx> -123456789 (fxadd -123456791 2 ))        => "#f\n" ]
+  [(fx> -123456789 (fxadd1 -123456790))          => "#f\n" ]
+  [(fx> -123456789 (fx+ -123456791 2))           => "#f\n" ]
 
   [(char< #\A #\A)                               => "#f\n" ]
   [(char< #\A #\B)                               => "#t\n" ]

<Prev in Thread] Current Thread [Next in Thread>
  • [svn:parrot] r24499 - in trunk/languages/eclectus: . t, bernhard <=