Changeset 5355 for src/Pugs/Compile

Timestamp:

07/10/05 12:56:06 (3 years ago)

Author:

autrijus

svk:copy_cache_prev:

7349

Message:

* initial work for getting Compile Exp right (still a couple to be filled)

Files:

• src/Pugs/Compile/Pugs.hs (modified) (3 diffs)

src/Pugs/Compile/Pugs.hs

@@ -64 +64 @@
                 , text ("return (Pad " ++ show scope ++ " pad exp)")
                 ]
+    compile (Pos pos exp) = compileShow2 "Pos" pos exp
+    compile (Cxt cxt exp) = compileShow2 "Cxt" cxt exp
     compile exp = return $ text "return" $+$ parens (text $ show exp)
+
+compileShow2 :: Show a => String -> a -> Exp -> Eval Doc
+compileShow2 con anno exp = do
+    expC <- compile exp
+    return $ prettyDo
+        [ prettyBind "exp" expC
+        , text ("return (" ++ con ++ " " ++ show anno ++ " exp)")
+        ]
 
 instance Compile Pad where
@@ -140 +150 @@
             $(liftM TH.ListE $ 
               mapM (\name -> [|(name, tshow $
-                                $(TH.varE $ TH.mkName name) code)|]) $
+                                $(TH.varE $ TH.mkName name) code{ subEnv = Nothing })|]) $
               ["isMulti", "subName", "subType", "subEnv", "subAssoc",
               "subParams", "subBindings", "subSlurpLimit",
@@ -151 +161 @@
 #else 
     compile code | subType code == SubPrim = return $ text "mkPrim"
-    compile code = return $ text $ show code
+    compile code = return $ text $ show code{ subType = Nothing }
 #endif