3 {- This module contains a few primitive types that need to be wired in.
4 Most are defined in PrimEnv, which is automatically generated from
7 module Prims(initialEnv, primEnv, newPrimVars) where
18 initialEnv = efromlist [(primMname,primEnv),
22 -- Tediously, we add defs for ByteArray# etc. because these are
23 -- declared as ByteArr# (etc.) in primops.txt, and GHC has
24 -- ByteArray# etc. wired-in.
25 -- At least this is better than when all primops were wired-in here.
26 primEnv = Envs {tcenv_=efromlist $ map (\ (t,k) -> (t,Kind k)) $
27 [(snd tcByteArrayzh,ktByteArrayzh),
28 (snd tcMutableArrayzh, ktMutableArrayzh),
29 (snd tcMutableByteArrayzh, ktMutableByteArrayzh)] ++
30 ([(snd $ tcUtuple n, ktUtuple n) | n <- [1..maxUtuple]]
31 ++ ((snd tcArrow,ktArrow):primTcs)),
33 cenv_=efromlist primDcs,
34 venv_=efromlist (newPrimVars ++ opsState ++ primVals)}
37 errorEnv = Envs {tcenv_=eempty,
40 venv_=efromlist errorVals}
43 newPrimVars :: [(Id, Ty)]
44 newPrimVars = map (\ (v, ty) -> (zEncodeString v, ty))
45 [("hPutChar#", mkFunTy tIntzh (mkFunTy tCharzh tIOUnit)),
46 ("isSpace#", mkFunTy tCharzh tBool)]
49 primDcs :: [(Dcon,Ty)]
50 primDcs = map (\ ((_,c),t) -> (c,t))
51 [(dcUtuple n, dcUtupleTy n) | n <- [1..maxUtuple]]
54 tRWS = tStatezh tRealWorld
56 opsState :: [(Var, Ty)]
58 ("realWorldzh", tRWS)]
62 tcByteArrayzh, tcMutableArrayzh, tcMutableByteArrayzh :: Qual Tcon
63 ktByteArrayzh, ktMutableArrayzh, ktMutableByteArrayzh :: Kind
65 tcByteArrayzh = pvz "ByteArray"
66 ktByteArrayzh = Kunlifted
68 tcMutableArrayzh = pvz "MutableArray"
69 ktMutableArrayzh = Karrow Klifted (Karrow Klifted Kunlifted)
71 tcMutableByteArrayzh = pvz "MutableByteArray"
72 ktMutableByteArrayzh = Karrow Klifted Kunlifted
74 {- Real world and state. -}
76 -- tjc: why isn't this one unboxed?
77 tcRealWorld :: Qual Tcon
78 tcRealWorld = pv "RealWorld"
80 tRealWorld = Tcon tcRealWorld
82 tcStatezh :: Qual Tcon
83 tcStatezh = pvz "State"
85 tStatezh t = Tapp (Tcon tcStatezh) t
87 {- Properly defined in PrelError, but needed in many modules before that. -}
88 errorVals :: [(Var, Ty)]
90 ("error", Tforall ("a",Kopen) (tArrow tString (Tvar "a"))),
91 ("irrefutPatError", str2A),
93 ("divZZeroError", forallAA),
94 ("overflowError", forallAA)]
96 {- Non-primitive, but mentioned in the types of primitives. -}
101 str2A, forallAA :: Ty
102 str2A = Tforall ("a",Kopen) (tArrow tAddrzh (Tvar "a"))
103 forallAA = Tforall ("a",Kopen) (Tvar "a")
106 tBool = Tcon (Just boolMname, "Bool")
114 tList t = Tapp (Tcon tcList) t
116 tString = tList tChar
117 tIntzh, tCharzh, tIOUnit :: Ty
118 tIntzh = Tcon (primId "Int#")
119 tCharzh = Tcon (primId "Char#")
120 tIOUnit = Tapp (Tcon (Just (mkBaseMname "IOBase"), "IO"))
123 primId :: String -> Qual Id
124 primId = pv . zEncodeString