Changeset 22172

Timestamp:

09/06/08 18:03:57 (3 months ago)

Author:

pmurias

Message:

[pugs-m0ld] pattern matching is done with case instead of multiple function definitions

Files:

• src/Pugs/CodeGen/M0ld.hs (modified) (2 diffs)

src/Pugs/CodeGen/M0ld.hs

@@ -8 +8 @@
 import Control.Monad.State
 
-uniqueId =
-    do
-        modify (+1)
-        id <- get
-        return $ "$id"++(show id)
+uniqueId = do
+    modify (+1)
+    id <- get
+    return $ "$id"++(show id)
 void = "$void"
 
@@ -19 +18 @@
 
 instance EmitM0ld PIL_Environment where
-    emit x r = emit (pilMain x) r
+    emit env r = emit (pilMain env) 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
+    emit statement r = case statement of
+        PNil                           -> return "nil"
+        PPad {}                        -> return "pad"
+        PStmts{pStmt=stmt,pStmts=PNil} -> emit stmt r
+        PStmts{pStmt=stmt,pStmts=rest} -> do 
+            stmt <- emit stmt void
+            rest <- emit rest void
+            return $ stmt ++ rest
 
 instance EmitM0ld PIL_Stmt where
-    emit PPos {pNode=stmt} r = emit stmt r
-    emit PNoop r = return "; #noop\n"
-    emit PStmt {pExpr=expr} r = emit expr r
+    emit statement r = case statement of 
+        PPos {pNode=stmt}  -> emit stmt r
+        PNoop              -> return "; #noop\n"
+        PStmt {pExpr=expr} -> emit expr r
 
 instance EmitM0ld PIL_Expr where
-    emit PExp {pLV=lv} r = emit lv r
-    emit PCode {pBody=body} r =
-     do
-        ret <- uniqueId
-        body <- emit body ret
-        return ("my " ++ r ++ " = $Code.\"new\"(mold {\n"
-         ++ body
-         ++ void ++ " = $interpreter.\"return\"(" ++ ret ++ ");\n"
-         ++ "});\n")
+    emit expr r = case expr of 
+        PExp {pLV=lv} -> emit lv r
+        PCode {pBody=body} -> do
+            ret <- uniqueId
+            body <- emit body ret
+            return ("my " ++ r ++ " = $Code.\"new\"(mold {\n"
+                ++ body
+                ++ void ++ " = $interpreter.\"return\"(" ++ ret ++ ");\n"
+                ++ "});\n")
 
 instance EmitM0ld PIL_LValue where
-    emit PApp {pFun=fun,pArgs=args,pInv=Nothing} r =
-     do
-        fun_r <- uniqueId
-        fun_code <- emit fun fun_r
-        return (fun_code ++ "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
+    emit lvalue r = case lvalue of
+        PApp {pFun=fun,pArgs=args,pInv=Nothing} -> do
+            fun_r <- uniqueId
+            fun_code <- emit fun fun_r
+            return (fun_code ++ "my " ++ r ++ " = " ++ fun_r ++ ".\"postcircumfix:( )\"(" ++ (show args) ++ ");\n")
+        PApp {pFun=fun,pArgs=args,pInv=Just inv} -> do
+            inv <- emit inv r
+            fun <- emit fun r
+            return (inv ++ ".(" ++ fun ++ ")(" ++ (show args) ++ ")")
+        PVar {pVarName=name} -> do
+            return $ "my " ++ r ++ " = $scope.\"postcircumfix:{ }\"(\"" ++ name ++ "\");\n"
+        other -> return $ show other 
 
 genM0ld :: FilePath -> Eval Val
 genM0ld filepath = do
     penv <- compile () :: Eval PIL_Environment
-    return $ VStr $ (evalState (emit penv "out") 0) ++ "\n"
+    return $ VStr $ (evalState (emit penv void) 0) ++ "\n"