Changeset 22313

Timestamp:

09/22/08 19:30:53 (2 months ago)

Author:

pmurias

Message:

[pugs][smop]
lexical variable work in pugs -Cm0ld
Pugs.Compile.compile marks lexical delarations in PIL1 although not fully correctly

Files:

• src/Pugs/CodeGen/M0ld.hs (modified) (3 diffs)
• src/Pugs/Compile.hs (modified) (3 diffs)
• v6/smop/src/smop_s1p_hash.c (modified) (1 diff)
• v6/smop/src/smop_s1p_root_namespace.c (modified) (1 diff)
• v6/smop/test/33_pugs_simple.p6-pugs (modified) (1 diff)

src/Pugs/CodeGen/M0ld.hs

@@ -28 +28 @@
     ++ "$void = $OUT_scalar.\"STORE\"($OUT_root);\n"
     ++ "\n"
+
     ++ "my $Code_scalar = $scope.\"postcircumfix:{ }\"(\"Code\");\n"
     ++ "my $Code_root_scalar = ?SMOP__S1P__RootNamespace.\"postcircumfix:{ }\"(\"::Code\");\n"
     ++ "my $Code = $Code_root_scalar.\"FETCH\"();\n"
     ++ "$void = $Code_scalar.\"STORE\"($Code);\n"
+
+    ++ "my $Scalar_scalar = $scope.\"postcircumfix:{ }\"(\"Scalar\");\n"
+    ++ "my $Scalar_root_scalar = ?SMOP__S1P__RootNamespace.\"postcircumfix:{ }\"(\"::Scalar\");\n"
+    ++ "my $Scalar = $Scalar_root_scalar.\"FETCH\"();\n"
+    ++ "$void = $Scalar_scalar.\"STORE\"($Scalar);\n"
+
     ++ "\n"
     ++ "\n"
@@ -41 +48 @@
             ++ "my $Code_scalar = $scope.\"lookup\"(\"Code\");\n"
             ++ "my $Code = $Code_scalar.\"FETCH\"();\n"
+            ++ "my $Scalar_scalar = $scope.\"lookup\"(\"Scalar\");\n"
+            ++ "my $Scalar = $Scalar_scalar.\"FETCH\"();\n"
 
 instance EmitM0ld PIL_Environment where
@@ -49 +58 @@
     emit statement r = case statement of
         PNil                           -> return "nil"
-        PPad {}                        -> return "pad"
+        PPad {pStmts=rest,pScope=SMy,pSyms=[(var,_)]} -> do
+            new_scalar <- uniqueId
+            lexpad_cell <- uniqueId
+            rest <- emit rest r
+            return $
+                "my " ++ new_scalar ++ " = $Scalar.\"new\"();\n"
+                ++  "my " ++ lexpad_cell ++ " = $scope.\"postcircumfix:{ }\"(" ++ (show var) ++ ");\n"
+                ++ "my $void = " ++ lexpad_cell ++ ".\"STORE\"(" ++ new_scalar ++ ");\n"
+                ++ rest
         PStmts{pStmt=stmt,pStmts=PNil} -> emit stmt r
         PStmts{pStmt=stmt,pStmts=rest} -> do 

src/Pugs/Compile.hs

@@ -26 +26 @@
 import Language.PIR
 import Text.PrettyPrint
+import qualified Data.ByteString.Char8 as BS
 
 tcVoid, tcLValue :: TCxt
@@ -384 +385 @@
 _PVar = PVar . cast
 
+addPad stmt entry = PPad{pStmts=stmt,pScope=SMy,pSyms=[((BS.unpack $ cast $ fst entry),PRawName "...")]}
 {-| Compiles various 'Exp's to 'PIL_Expr's. -}
 instance Compile Exp PIL_Expr where
@@ -399 +401 @@
         bodyC   <- compile body
         return $ PExp $ PApp cxt (pBlock bodyC) Nothing []
-    compile (Syn "sub" [Val (VCode sub)]) = do
+    compile (Syn "sub" [Val (VCode sub)]) =  do
         bodyC   <- enter sub $ compile $ case subBody sub of
             Syn "block" [exp]   -> exp
             exp                 -> exp
         paramsC <- compile $ subParams sub
-        return $ PCode (subType sub) paramsC (subLValue sub) (isMulti sub) bodyC
+        return $ PCode (subType sub) paramsC (subLValue sub) (isMulti sub) (foldl addPad bodyC (padToList $ subInnerPad sub))
     compile (Syn "module" _) = compile Noop
     compile (Syn "match" exp) = compile $ Syn "rx" exp -- wrong

v6/smop/src/smop_s1p_hash.c

@@ -74 +74 @@
       ret = SMOP_REFERENCE(interpreter,cell);
     } else {
-      fprintf(stderr,"wrong number of arguments to postrcicumfix:<{ }>\n");
+      fprintf(stderr,"wrong number of arguments to postcircumfix:<{ }>\n");
     }
 

v6/smop/src/smop_s1p_root_namespace.c

@@ -30 +30 @@
   smop_s1p_root_namespace_insert(SMOP__GlobalInterpreter,"::MoldFrame", SMOP__Mold__Frame);
   smop_s1p_root_namespace_insert(SMOP__GlobalInterpreter,"::Code", SMOP__S1P__Code);
+  smop_s1p_root_namespace_insert(SMOP__GlobalInterpreter,"::Scalar", SMOP__S1P__Scalar);
 }
 

v6/smop/test/33_pugs_simple.p6-pugs

@@ -1 @@
-$*OUT.print("1..","1\n");
-$*OUT.print("ok 1\n");
+my $one = "1";
+$*OUT.print("1..1","\n");
+$*OUT.print("ok ",$one,"\n");