Skip to content

Commit a12f074

Browse files
RyanGlScottRyanGlScott
committed
Add builtin Types module
1 parent a5bfa4b commit a12f074

File tree

3 files changed

+209
-0
lines changed

3 files changed

+209
-0
lines changed

‎language-bluespec.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -53,6 +53,7 @@ library
5353

5454
Language.Bluespec.Classic.AST.Builtin.FStrings
5555
Language.Bluespec.Classic.AST.Builtin.Ids
56+
Language.Bluespec.Classic.AST.Builtin.Types
5657

5758
Language.Bluespec.Lex
5859
Language.Bluespec.Pretty

‎src/Language/Bluespec/Classic/AST/Builtin/Types.hs

Lines changed: 204 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,204 @@
1+
-- This corresponds to src/Comp/Type.hs in bsc.
2+
module Language.Bluespec.Classic.AST.Builtin.Types where
3+
4+
import Language.Bluespec.Classic.AST.Builtin.Ids
5+
import Language.Bluespec.Classic.AST.Id
6+
import Language.Bluespec.Classic.AST.Position
7+
import Language.Bluespec.Classic.AST.Type
8+
import Language.Bluespec.Prelude
9+
import Language.Bluespec.Pretty
10+
11+
infixr 4 `fn`
12+
13+
-- XXX these definitions should be synced with StdPrel.hs where applicable
14+
15+
tArrow, tBit, tInt :: Type
16+
tArrow = TCon (TyCon (idArrow noPosition) (Just (Kfun KStar (Kfun KStar KStar))) TIabstract)
17+
tBit = TCon (TyCon idBit (Just (Kfun KNum KStar)) TIabstract)
18+
tInt = TCon (TyCon idInt (Just (Kfun KNum KStar)) TIabstract)
19+
20+
tIntAt :: Position -> Type
21+
tIntAt pos = TCon (TyCon (idIntAt pos) (Just (Kfun KNum KStar)) TIabstract)
22+
23+
tiData, tiEnum :: [Id] -> TISort
24+
tiEnum cons = TIdata { tidata_cons = cons, tidata_enum = True }
25+
tiData cons = TIdata { tidata_cons = cons, tidata_enum = False }
26+
27+
tUInt, tBool, tPrimUnit :: Type
28+
tUInt = TCon (TyCon idUInt (Just (Kfun KNum KStar)) TIabstract)
29+
tBool = TCon (TyCon idBool (Just KStar) (tiEnum [idFalse, idTrue]))
30+
--tArray = TCon (TyCon idArray (Just (Kfun KNum (Kfun KNum KStar))) (TIstruct SInterface [id_sub, id_upd]))
31+
tPrimUnit = TCon (TyCon idPrimUnit (Just KStar) (TIstruct SStruct []))
32+
33+
tPrimUnitAt :: Position -> Type
34+
tPrimUnitAt pos = TCon (TyCon (idPrimUnitAt pos) (Just KStar) (TIstruct SStruct []))
35+
36+
tInteger, tReal :: Type
37+
tInteger = TCon (TyCon idInteger (Just KStar) TIabstract)
38+
tReal = TCon (TyCon idReal (Just KStar) TIabstract)
39+
40+
tRealAt :: Position -> Type
41+
tRealAt pos = TCon (TyCon (idRealAt pos) (Just KStar) TIabstract)
42+
43+
tClock, tReset, tInout, tInout_, tChar, tString :: Type
44+
tClock = TCon (TyCon idClock (Just KStar) TIabstract)
45+
tReset = TCon (TyCon idReset (Just KStar) TIabstract)
46+
tInout = TCon (TyCon idInout (Just (Kfun KStar KStar)) TIabstract)
47+
tInout_ = TCon (TyCon idInout_ (Just (Kfun KNum KStar)) TIabstract)
48+
tString = TCon (TyCon idString (Just KStar) TIabstract)
49+
tChar = TCon (TyCon idChar (Just KStar) TIabstract)
50+
51+
tFmt, tName, tPosition, tType :: Type
52+
tFmt = TCon (TyCon idFmt (Just KStar) TIabstract)
53+
tName = TCon (TyCon idName (Just KStar) TIabstract)
54+
tPosition = TCon (TyCon idPosition (Just KStar) TIabstract)
55+
tType = TCon (TyCon idType (Just KStar) TIabstract)
56+
57+
tPred, tAttributes, tPrimPair, tSizeOf :: Type
58+
tPred = TCon (TyCon idPred (Just KStar) TIabstract)
59+
tAttributes = TCon (TyCon idAttributes (Just KStar) TIabstract)
60+
tPrimPair = TCon (TyCon idPrimPair (Just (Kfun KStar (Kfun KStar KStar))) (TIstruct SStruct [idPrimFst, idPrimSnd]))
61+
tSizeOf = TCon (TyCon idSizeOf (Just (Kfun KStar KNum)) TIabstract)
62+
63+
tAction, tActionValue, tActionValue_, tAction_:: Type
64+
tAction = TCon (TyCon idAction (Just KStar) (TItype 0 (TAp tActionValue tPrimUnit)))
65+
tActionValue = TCon (TyCon idActionValue (Just (Kfun KStar KStar)) (TIstruct SStruct [id__value, id__action]))
66+
tActionValue_ = TCon (TyCon idActionValue_ (Just (Kfun KNum KStar)) (TIstruct SStruct [id__value, id__action]))
67+
tAction_ = TAp tActionValue_ (tOfSize 0 noPosition)
68+
69+
tActionAt, tActionValueAt, tActionValue_At :: Position -> Type
70+
tActionAt pos = TCon (TyCon (idActionAt pos) (Just KStar) (TItype 0 (TAp (tActionValueAt pos) (tPrimUnitAt pos))))
71+
tActionValueAt pos = TCon (TyCon (idActionValueAt pos) (Just (Kfun KStar KStar)) (TIstruct SStruct [id__value_at pos, id__action_at pos]))
72+
tActionValue_At pos = TCon (TyCon (idActionValue_At pos) (Just (Kfun KNum KStar)) (TIstruct SStruct [id__value_at pos, id__action_at pos]))
73+
74+
tPrimAction, tRules :: Type
75+
tPrimAction = TCon (TyCon idPrimAction (Just KStar) TIabstract)
76+
tRules = TCon (TyCon idRules (Just KStar) TIabstract)
77+
78+
tRulesAt :: Position -> Type
79+
tRulesAt pos = TCon (TyCon (idRulesAt pos) (Just KStar) TIabstract)
80+
81+
tSchedPragma, tModule, tVRWireN, tId, t32 :: Type
82+
tSchedPragma = TCon (TyCon idSchedPragma (Just KStar) TIabstract)
83+
tModule = TCon (TyCon idModule (Just (Kfun KStar KStar)) TIabstract)
84+
tVRWireN = TCon (TyCon idVRWireN (Just (Kfun KNum KStar)) (TIstruct SStruct [idWSet, idWGet, idWHas]))
85+
tId = TCon (TyCon idId (Just (Kfun KStar KStar)) TIabstract)
86+
t32 = tOfSize 32 noPosition
87+
88+
t32At :: Position -> Type
89+
t32At pos = tOfSize 32 pos
90+
91+
tOfSize :: Integer -> Position -> Type
92+
tOfSize n pos = cTNum n pos
93+
94+
tInt32At :: Position -> Type
95+
tInt32At pos = TAp (tIntAt pos) (t32At pos)
96+
97+
tBitN :: Integer -> Position -> Type
98+
tBitN n pos = TAp tBit (tOfSize n pos)
99+
100+
tNat :: Position -> Type
101+
tNat pos = tBitN 32 pos
102+
103+
tFile, tSvaParam :: Type
104+
tFile = TCon (TyCon idFile (Just KStar) TIabstract)
105+
tSvaParam = TCon (TyCon idSvaParam (Just KStar) (tiData [idSvaBool, idSvaNumber]))
106+
107+
fn :: Type -> Type -> Type
108+
a `fn` b = TAp (TAp tArrow a) b
109+
110+
-- numeric kinds and type constructors
111+
kNNN, kNN, kNNS, kNS :: Kind
112+
kNNN = Kfun KNum kNN
113+
kNN = Kfun KNum KNum
114+
115+
kNNS = Kfun KNum kNS
116+
kNS = Kfun KNum KStar
117+
118+
tAdd, tSub, tMul, tDiv, tLog, tExp, tMax, tMin :: Type
119+
tAdd = TCon (TyCon idTAdd (Just kNNN) TIabstract)
120+
tSub = TCon (TyCon idTSub (Just kNNN) TIabstract)
121+
tMul = TCon (TyCon idTMul (Just kNNN) TIabstract)
122+
tDiv = TCon (TyCon idTDiv (Just kNNN) TIabstract)
123+
tLog = TCon (TyCon idTLog (Just kNN) TIabstract)
124+
tExp = TCon (TyCon idTExp (Just kNN) TIabstract)
125+
tMax = TCon (TyCon idTMax (Just kNNN) TIabstract)
126+
tMin = TCon (TyCon idTMin (Just kNNN) TIabstract)
127+
128+
class HasKind t where
129+
kind :: t -> Kind
130+
131+
instance HasKind TyVar where
132+
kind (TyVar _v _ k) = k
133+
134+
instance HasKind TyCon where
135+
kind (TyCon _v (Just k) _) = k
136+
kind (TyNum _ _) = KNum
137+
kind (TyStr _ _) = KStr
138+
kind (TyCon _v Nothing _) = error "HasKind(TyCon).kind: TyCon without kind"
139+
140+
instance HasKind Type where
141+
kind (TCon tc) = kind tc
142+
kind (TVar u) = kind u
143+
kind tt@(TAp t _) = case kind t of
144+
Kfun _ k -> k
145+
k ->
146+
error ("kind: " ++ ppReadable k ++ (show tt) ++ "\n")
147+
kind (TGen _ _) = error "HasKind(Type).kind: TGen"
148+
kind (TDefMonad _) = error "HasKind(Type).kind: TDefMonad"
149+
150+
arrow :: Type -> Type -> Type
151+
arrow a r = TAp (TAp tArrow a) r
152+
153+
154+
-- -------------------------
155+
156+
-- XXX kill this
157+
isPrimAction :: Type -> Bool
158+
isPrimAction t = t == tPrimAction
159+
160+
isActionValue :: Type -> Bool
161+
isActionValue (TAp av _) = av == tActionValue
162+
isActionValue _ = False
163+
164+
getAVType :: Type -> Type
165+
getAVType (TAp av t) | av == tActionValue = t
166+
getAVType t = error("getAVType not ActionValue: " ++ ppReadable t)
167+
168+
isActionWithoutValue :: Type -> Bool
169+
isActionWithoutValue (TAp av (TCon (TyNum 0 _))) = av == tActionValue_
170+
isActionWithoutValue _ = False
171+
172+
isActionWithValue :: Type -> Bool
173+
isActionWithValue (TAp av (TCon (TyNum n _))) = (av == tActionValue_) && (n > 0)
174+
isActionWithValue (TAp av (TVar _)) = av == tActionValue_
175+
isActionWithValue _ = False
176+
177+
isClock, isReset, isInout, isInout_ :: Type -> Bool
178+
isClock t = t == tClock
179+
isReset t = t == tReset
180+
181+
isInout (TAp i _) = i == tInout
182+
isInout _ = False
183+
184+
isInout_ (TAp i _) = i == tInout_
185+
isInout_ _ = False
186+
187+
isBit, isInt, isUInt, isBool, isInteger, isString, isChar, isReal, isFmt :: Type -> Bool
188+
isBit (TAp b _) = b == tBit
189+
isBit _ = False
190+
191+
isInt (TAp i _) = i == tInt
192+
isInt _ = False
193+
194+
isUInt (TAp u _) = u == tUInt
195+
isUInt _ = False
196+
197+
isBool t = t == tBool
198+
isInteger t = t == tInteger
199+
isString t = t == tString
200+
isChar t = t == tChar
201+
isReal t = t == tReal
202+
isFmt t = t == tFmt
203+
204+
-- -------------------------

‎src/Language/Bluespec/Classic/AST/Type.hs

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,7 @@ module Language.Bluespec.Classic.AST.Type
1414
, CQType(..)
1515

1616
, baseKVar
17+
, cTNum
1718
, isTConArrow
1819
, isTConPair
1920
, leftCon
@@ -65,6 +66,9 @@ instance HasPosition Type where
6566
getPosition (TGen pos _) = pos
6667
getPosition (TDefMonad pos) = pos
6768

69+
cTNum :: Integer -> Position -> CType
70+
cTNum n pos = TCon (TyNum n pos)
71+
6872
isTConArrow :: TyCon -> Bool
6973
isTConArrow (TyCon i _ _) = i == idArrow noPosition
7074
isTConArrow t = error("isTConArrow: not TCon " ++ show t)

0 commit comments

Comments
 (0)