Changeset 5355

Timestamp:

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

Author:

autrijus

svk:copy_cache_prev:

7349

Message:

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

Location:

src/Pugs

Files:

• AST/Internals.hs (modified) (3 diffs)
• Compile/Pugs.hs (modified) (3 diffs)

src/Pugs/AST/Internals.hs

@@ -56 +56 @@
     retError, retControl, retEmpty, retIVar, readIVar, writeIVar,
     fromVals, refType,
-    lookupPad, padToList,
+    lookupPad, padToList, listToPad,
     mkPrim, mkSub, showRat,
     cxtOfSigil, typeOfSigil,
@@ -1078 +1078 @@
 -}
 data Pad = MkPad !(Map Var ([(TVar Bool, TVar VRef)]))
-    deriving (Show, Eq, Ord, Typeable)
+    deriving (Eq, Ord, Typeable)
+
+instance Show Pad where
+    show pad = "MkPad (padToList " ++ show (padToList pad) ++ ")"
 
 -- | Look up a symbol in a 'Pad', returning the ref it is bound to.
@@ -1103 +1106 @@
 padToList :: Pad -> [(Var, [(TVar Bool, TVar VRef)])]
 padToList (MkPad map) = Map.assocs map
+
+listToPad :: [(Var, [(TVar Bool, TVar VRef)])] -> Pad
+listToPad = MkPad . Map.fromList
 
 {- Eval Monad -}

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