Changeset 4911

Timestamp:

06/22/05 19:19:04 (4 years ago)

Author:

autrijus

svk:copy_cache_prev:

6641

Message:

* So much for not compromising... change the := ?? :: line

in Test.pm so it can work with PIR.

Files:

• ext/Test/lib/Test.pm (modified) (2 diffs)
• src/Pugs/Compile/PIR.hs (modified) (4 diffs)

ext/Test/lib/Test.pm

@@ -203 +203 @@
     $context = "TODO for release" if $num_of_tests_run == $force_todo_test_junction;    
 
-    my $ok := $cond ?? "ok " :: "not ok ";
     my $out = $desc.defined ?? " - $desc" :: "";
     $out = "$out <pos:$?CALLER::CALLER::POSITION>" if $ALWAYS_CALLER;
@@ -209 +208 @@
     my $context_out = $context.defined ?? " # $context" :: "";
 
-    say $ok, $num_of_tests_run, $out, $context_out;
+    say "not " unless $cond;
+    say "ok ", $num_of_tests_run, $out, $context_out;
 
     report_failure($context, $got, $expected) unless $cond;

src/Pugs/Compile/PIR.hs

@@ -182 +182 @@
 instance Compile (SubName, VCode) [PIL Decl] where
     compile (name, vsub) | packageOf name /= packageOf (subName vsub) = do
-        let storeC  = PAssign [PVar $ qualify name] (PExp . PVar . qualify $ subName vsub)
+        let storeC  = PBind [PVar $ qualify name] (PExp . PVar . qualify $ subName vsub)
             bodyC   = PStmts (PStmt . PExp $ storeC) PNil
             exportL = "__export_" ++ (render $ varText name)
@@ -473 +473 @@
         tellIns $ lhsC <== rhsC
         return lhsC
+    trans (PBind [PVar name] rhs)
+        | Just (pkg, name') <- isQualified (qualify name) = do
+        rhsC    <- trans rhs
+        tellIns $ "store_global" .- [lit pkg, lit name', rhsC]
+        trans (PVar name)
     trans (PBind [lhs] rhs) = do
         lhsC    <- enter tcLValue $ trans lhs
@@ -498 +503 @@
             then mapM trans (head args : map PThunk (tail args))
             else mapM trans args
+        -- XXX WORKAROUND PARROT BUG (see below)
+        pmc     <- genLV "app"
+        -- XXX - probe if funC is slurpy, then modify ExpLV pmc accordingly
+        tellIns $ [reg pmc] <-& funC $ argsC
+        return pmc
+        {- XXX PARROT BUG -- tailcall broken
         case cxt of
             TTailCall _ -> do
@@ -507 +518 @@
                 tellIns $ [reg pmc] <-& funC $ argsC
                 return pmc
+        -}
         where
         -- XXX HACK