Changeset 22170

Timestamp:

09/06/08 17:02:15 (3 months ago)

Author:

pmurias

Message:

[pugs] pre-working (ugly) start of the m0ld pugs backend

Files:

• src/Pugs/CodeGen/M0ld.hs (modified) (1 diff)

src/Pugs/CodeGen/M0ld.hs

@@ -6 +6 @@
 import Pugs.PIL1.Instances ()
 import Pugs.PIL1
+import Control.Monad.State
 
--- XXX: do something useful with the filename arg
+class EmitM0ld a where
+    emit :: a -> [Char] -> State Int [Char]
+
+instance EmitM0ld PIL_Environment where
+    emit x r = emit (pilMain x) r
+instance EmitM0ld PIL_Stmts where
+    emit PNil r = return "nil"
+    emit PPad {} r = return "pad"
+    emit PStmts{pStmt=stmt,pStmts=PNil} r = (emit stmt "void")
+    emit PStmts{pStmt=stmt,pStmts=rest} r = do 
+        stmt <- emit stmt "void"
+        rest <- emit rest "void"
+        return $ stmt ++ rest
+
+instance EmitM0ld PIL_Stmt where
+    emit PPos {pNode=stmt} = emit stmt
+    emit PNoop = \_-> return ";\n"
+    emit PStmt {pExpr=expr} = emit expr
+
+instance EmitM0ld PIL_Expr where
+    emit PExp {pLV=lv} r = emit lv r
+    emit PCode {pBody=body} r =
+     do
+        body <- emit body "void"
+        let ret = "?"
+        return ("my $" ++ r ++ " = $Code.\"new\"(mold {\n"
+         ++ body
+         ++ "$interpreter.\"return\"($" ++ ret ++ ");\n"
+         ++ "});\n")
+
+instance EmitM0ld PIL_LValue where
+    emit PApp {pFun=fun,pArgs=args,pInv=Nothing} r =
+     do
+        let fun_r = "?"
+        fun <- emit fun fun_r
+        return (fun ++ "my $" ++ r ++ " = $" ++ fun_r ++ ".\"postcircumfix:( )\"(" ++ (show args) ++ ");\n")
+    emit PApp {pFun=fun,pArgs=args,pInv=Just inv} r =
+     do
+        inv <- emit inv r
+        fun <- emit fun r
+        return (inv ++ ".(" ++ fun ++ ")(" ++ (show args) ++ ")")
+    emit PVar {pVarName=name} r =
+     do
+        return $ "my $" ++ r ++ " = $scope.\"postcircumfix:{ }\"(\"" ++ name ++ "\");\n"
+    emit x r = return $ show x
+
 genM0ld :: FilePath -> Eval Val
 genM0ld filepath = do
     penv <- compile () :: Eval PIL_Environment
-    return $ VStr $ (show penv)
+    return $ VStr $ (evalState (emit penv "out") 0) ++ "\n"