X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=utils%2Fext-core%2FPrims.hs;h=5193848cbf9d5df3a28702935b0be76783b1a90f;hp=d061200ce50b0ef4930a7a5d76909c6d09a085b5;hb=8bfeb25ae78e99c7014113468b0057342db4208f;hpb=420a27dc9fb7de5fc6c96fe078ddd4dc87222d44

diff --git a/utils/ext-core/Prims.hs b/utils/ext-core/Prims.hs
index d061200..5193848 100644
--- a/utils/ext-core/Prims.hs
+++ b/utils/ext-core/Prims.hs
@@ -4,9 +4,10 @@
    Most are defined in PrimEnv, which is automatically generated from
    GHC's primops.txt. -}
 
-module Prims(initialEnv, primEnv) where
+module Prims(initialEnv, primEnv, newPrimVars) where
 
 import Core
+import Encoding
 import Env
 import Check
 import PrimCoercions
@@ -28,17 +29,21 @@ primEnv = Envs {tcenv_=efromlist $ map (\ (t,k) -> (t,Kind k)) $
                    (snd tcMutableByteArrayzh, ktMutableByteArrayzh)] ++
                  ([(snd $ tcUtuple n, ktUtuple n) | n <- [1..maxUtuple]] 
                    ++ ((snd tcArrow,ktArrow):primTcs)),
-		tsenv_=eempty,
 		cenv_=efromlist primDcs,
-		venv_=efromlist (opsState ++ primVals)}
+		venv_=efromlist (newPrimVars ++ opsState ++ primVals)}
 
 errorEnv :: Envs
 errorEnv = Envs {tcenv_=eempty,
-		 tsenv_=eempty,
 		 cenv_=eempty,
 		 venv_=efromlist errorVals}
 
 
+newPrimVars :: [(Id, Ty)]
+newPrimVars = map (\ (v, ty) -> (zEncodeString v, ty))
+  [("hPutChar#", mkFunTy tIntzh (mkFunTy tCharzh tIOUnit)),
+   ("isSpace#", mkFunTy tCharzh tBool)]
+
+
 primDcs :: [(Dcon,Ty)]
 primDcs = map (\ ((_,c),t) -> (c,t))
 	      [(dcUtuple n, dcUtupleTy n) | n <- [1..maxUtuple]]
@@ -95,6 +100,8 @@ str2A, forallAA :: Ty
 str2A = Tforall ("a",Kopen) (tArrow tAddrzh (Tvar "a"))
 forallAA = Tforall ("a",Kopen) (Tvar "a")
 
+tBool :: Ty
+tBool = Tcon (Just boolMname, "Bool")
 tcChar :: Qual Tcon
 tcChar = bv "Char"
 tChar :: Ty
@@ -105,3 +112,11 @@ tList :: Ty -> Ty
 tList t = Tapp (Tcon tcList) t
 tString :: Ty
 tString = tList tChar
+tIntzh, tCharzh, tIOUnit :: Ty
+tIntzh = Tcon (primId "Int#")
+tCharzh = Tcon (primId "Char#")
+tIOUnit = Tapp (Tcon (Just (mkBaseMname "IOBase"), "IO")) 
+               (Tcon (bv "Z0T"))
+
+primId :: String -> Qual Id
+primId = pv . zEncodeString
\ No newline at end of file