2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
4 \section[AbsPrel]{The @AbsPrel@ interface to the compiler's prelude knowledge}
7 #include "HsVersions.h"
11 -- unlike most export lists, this one is actually interesting :-)
13 -- re-export some PrimOp stuff:
14 PrimOp(..), typeOfPrimOp, primOpNameInfo,
15 HeapRequirement(..), primOpHeapReq, primOpCanTriggerGC,
16 primOpNeedsWrapper, primOpOkForSpeculation, primOpIsCheap,
18 PrimOpResultInfo(..), getPrimOpResultInfo,
19 pprPrimOp, showPrimOp, isCompareOp,
20 readUnfoldingPrimOp, -- actually, defined herein
22 pRELUDE, pRELUDE_BUILTIN, pRELUDE_CORE, pRELUDE_RATIO,
23 pRELUDE_LIST, pRELUDE_TEXT, --OLD: pRELUDE_ARRAY, pRELUDE_COMPLEX,
24 pRELUDE_PRIMIO, pRELUDE_IO, pRELUDE_PS,
25 gLASGOW_ST, {-gLASGOW_IO,-} gLASGOW_MISC,
27 -- lookup functions for built-in names, for the renamer:
30 -- *odd* values that need to be reached out and grabbed:
31 eRROR_ID, pAT_ERROR_ID, aBSENT_ERROR_ID,
33 unpackCStringId, unpackCString2Id,
34 unpackCStringAppendId, unpackCStringFoldrId,
35 integerZeroId, integerPlusOneId,
36 integerPlusTwoId, integerMinusOneId,
43 fromDomainId, toDomainId,
44 #endif {- Data Parallel Haskell -}
46 -----------------------------------------------------
47 -- the rest of the export list is organised by *type*
48 -----------------------------------------------------
50 -- "type": functions ("arrow" type constructor)
54 boolTyCon, boolTy, falseDataCon, trueDataCon,
56 -- types: Char#, Char, String (= [Char])
57 charPrimTy, charTy, stringTy,
58 charPrimTyCon, charTyCon, charDataCon,
60 -- type: CMP_TAG (used in deriving)
61 cmpTagTy, ltPrimDataCon, eqPrimDataCon, gtPrimDataCon,
63 -- types: Double#, Double
64 doublePrimTy, doubleTy,
65 doublePrimTyCon, doubleTyCon, doubleDataCon,
67 -- types: Float#, Float
69 floatPrimTyCon, floatTyCon, floatDataCon,
71 -- types: Glasgow *primitive* arrays, sequencing and I/O
72 mkPrimIoTy, -- to typecheck "mainIO", "mainPrimIO" & for _ccall_s
73 realWorldStatePrimTy, realWorldStateTy{-boxed-},
74 realWorldTy, realWorldTyCon, realWorldPrimId,
75 stateDataCon, getStatePairingConInfo,
77 -- types: Void# (only used within the compiler)
78 voidPrimTy, voidPrimId,
80 -- types: Addr#, Int#, Word#, Int
81 intPrimTy, intTy, intPrimTyCon, intTyCon, intDataCon,
82 wordPrimTyCon, wordPrimTy, wordTy, wordTyCon, wordDataCon,
83 addrPrimTyCon, addrPrimTy, addrTy, addrTyCon, addrDataCon,
85 -- types: Integer, Rational (= Ratio Integer)
86 integerTy, rationalTy,
87 integerTyCon, integerDataCon,
88 rationalTyCon, ratioDataCon,
91 liftTyCon, liftDataCon, mkLiftTy,
94 listTyCon, mkListTy, nilDataCon, consDataCon,
95 -- NOT USED: buildDataCon,
101 -- packedStringTyCon, packedStringTy, psDataCon, cpsDataCon,
103 -- for compilation of List Comprehensions and foldr
104 foldlId, foldrId, mkFoldl, mkFoldr,
105 mkBuild, buildId, augmentId, appendId,
109 mkPodTy, mkPodNTy, podTyCon, -- user model
110 mkPodizedPodNTy, -- podized model
111 mkInterfacePodNTy, interfacePodTyCon, mKINTERPOD_ID, -- interface model
113 -- Misc used during podization
114 primIfromPodNSelectorId,
115 #endif {- Data Parallel Haskell -}
117 -- and, finally, we must put in some (abstract) data types,
118 -- to make the interface self-sufficient
119 GlobalSwitch, Id, Maybe, Name, PprStyle, PrimKind, HeapOffset,
120 TyCon, UniType, TauType(..), Unique, CoreExpr, PlainCoreExpr(..)
122 IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
123 IF_ATTACK_PRAGMAS(COMMA mkStatePrimTy)
125 #ifndef __GLASGOW_HASKELL__
133 #endif {- Data Parallel Haskell -}
135 import PrelFuns -- help functions, types and things
138 import TysPrim -- TYPES
140 import PrelVals -- VALUES
141 import PrimOps -- PRIMITIVE OPS
143 import AbsUniType ( getTyConDataCons, TyCon
144 IF_ATTACK_PRAGMAS(COMMA cmpTyCon)
146 import CmdLineOpts ( GlobalSwitch(..) )
151 import Unique -- *Key stuff
155 This little devil is too small to merit its own ``TyFun'' module:
161 %************************************************************************
163 \subsection[builtinNameInfo]{Lookup built-in names}
165 %************************************************************************
167 We have two ``builtin name funs,'' one to look up @TyCons@ and
168 @Classes@, the other to look up values.
171 builtinNameInfo :: (GlobalSwitch -> Bool) -- access to global cmd-line flags
172 -> (FAST_STRING -> Maybe Name, -- name lookup fn for values
173 FAST_STRING -> Maybe Name) -- name lookup fn for tycons/classes
175 builtinNameInfo switch_is_on
176 = (init_val_lookup_fn, init_tc_lookup_fn)
179 -- values (including data constructors)
182 = if switch_is_on HideBuiltinNames then
184 else if switch_is_on HideMostBuiltinNames then
185 lookupFM (listToFM min_val_assoc_list)
186 -- OLD: mkStringLookupFn min_val_assoc_list False{-not pre-sorted-}
188 lookupFM (listToFM (concat list_of_val_assoc_lists))
189 -- mkStringLookupFn (concat list_of_val_assoc_lists) False{-not pre-sorted-}
191 min_val_assoc_list -- this is an ad-hoc list; what "happens"
192 = totally_wired_in_Ids -- to be needed (when compiling bits of
193 ++ unboxed_ops -- Prelude).
194 ++ (concat (map pcDataConNameInfo min_nonprim_tycon_list))
196 -- We let a lot of "non-standard" values be visible, so that we
197 -- can make sense of them in interface pragmas. It's cool, though
198 -- -- they all have "non-standard" names, so they won't get past
199 -- the parser in user code.
200 list_of_val_assoc_lists
201 = [ -- each list is empty or all there
203 totally_wired_in_Ids,
205 concat (map pcDataConNameInfo data_tycons),
209 if switch_is_on ForConcurrent then parallel_vals else []
213 -- type constructors and classes
216 = if switch_is_on HideBuiltinNames then
218 else if switch_is_on HideMostBuiltinNames then
219 lookupFM (listToFM min_tc_assoc_list)
220 --OLD: mkStringLookupFn min_tc_assoc_list False{-not pre-sorted-}
223 -- OLD: mkStringLookupFn
224 map pcTyConNameInfo (data_tycons ++ synonym_tycons)
225 ++ std_tycon_list -- TyCons not quite so wired in
228 -- The prim_tys,etc., are OK, because they all
229 -- have "non-standard" names (and we really
230 -- want them for interface pragmas).
231 --OLD: False{-not pre-sorted-}
233 min_tc_assoc_list -- again, pretty ad-hoc
234 = prim_tys ++ (map pcTyConNameInfo min_nonprim_tycon_list)
235 --HA! ++ std_class_list -- no harm in this
237 min_nonprim_tycon_list -- used w/ HideMostBuiltinNames
247 return2GMPsTyCon, -- ADR asked for these last two (WDP 94/11)
248 returnIntAndGMPTyCon ]
250 -- sigh: I (WDP) think these should be local defns
251 -- but you cannot imagine how bad it is for speed (w/ GHC)
252 prim_tys = map pcTyConNameInfo prim_tycons
257 = [(SLIT(":"), WiredInVal consDataCon),
258 (SLIT("error"), WiredInVal eRROR_ID),
259 (SLIT("patError#"), WiredInVal pAT_ERROR_ID), -- occurs in i/faces
260 (SLIT("parError#"), WiredInVal pAR_ERROR_ID), -- ditto
261 (SLIT("_trace"), WiredInVal tRACE_ID),
263 -- now the foldr/build Ids, which need to be built in
264 -- because they have magic unfoldings
265 (SLIT("_build"), WiredInVal buildId),
266 (SLIT("_augment"), WiredInVal augmentId),
267 (SLIT("foldl"), WiredInVal foldlId),
268 (SLIT("foldr"), WiredInVal foldrId),
269 (SLIT("unpackAppendPS#"), WiredInVal unpackCStringAppendId),
270 (SLIT("unpackFoldrPS#"), WiredInVal unpackCStringFoldrId),
272 (SLIT("_runST"), WiredInVal runSTId),
273 (SLIT("_seq_"), WiredInVal seqId), -- yes, used in sequential-land, too
275 (SLIT("realWorld#"), WiredInVal realWorldPrimId)
279 =[(SLIT("_par_"), WiredInVal parId),
280 (SLIT("_fork_"), WiredInVal forkId)
283 (SLIT("_parLocal_"), WiredInVal parLocalId),
284 (SLIT("_parGlobal_"), WiredInVal parGlobalId)
286 -- (SLIT("_parAt_"), WiredInVal parAtId)
287 -- (SLIT("_parAtForNow_"), WiredInVal parAtForNowId)
288 -- (SLIT("_copyable_"), WiredInVal copyableId)
289 -- (SLIT("_noFollow_"), WiredInVal noFollowId)
294 = (map primOpNameInfo lots_of_primops)
296 -- plus some of the same ones but w/ different names
297 [case (primOpNameInfo IntAddOp) of (_,n) -> (SLIT("+#"), n),
298 case (primOpNameInfo IntSubOp) of (_,n) -> (SLIT("-#"), n),
299 case (primOpNameInfo IntMulOp) of (_,n) -> (SLIT("*#"), n),
300 case (primOpNameInfo IntGtOp) of (_,n) -> (SLIT(">#"), n),
301 case (primOpNameInfo IntGeOp) of (_,n) -> (SLIT(">=#"), n),
302 case (primOpNameInfo IntEqOp) of (_,n) -> (SLIT("==#"), n),
303 case (primOpNameInfo IntNeOp) of (_,n) -> (SLIT("/=#"), n),
304 case (primOpNameInfo IntLtOp) of (_,n) -> (SLIT("<#"), n),
305 case (primOpNameInfo IntLeOp) of (_,n) -> (SLIT("<=#"), n),
306 case (primOpNameInfo DoubleAddOp) of (_,n) -> (SLIT("+##"), n),
307 case (primOpNameInfo DoubleSubOp) of (_,n) -> (SLIT("-##"), n),
308 case (primOpNameInfo DoubleMulOp) of (_,n) -> (SLIT("*##"), n),
309 case (primOpNameInfo DoubleDivOp) of (_,n) -> (SLIT("/##"), n),
310 case (primOpNameInfo DoublePowerOp) of (_,n) -> (SLIT("**##"), n),
311 case (primOpNameInfo DoubleGtOp) of (_,n) -> (SLIT(">##"), n),
312 case (primOpNameInfo DoubleGeOp) of (_,n) -> (SLIT(">=##"), n),
313 case (primOpNameInfo DoubleEqOp) of (_,n) -> (SLIT("==##"), n),
314 case (primOpNameInfo DoubleNeOp) of (_,n) -> (SLIT("/=##"), n),
315 case (primOpNameInfo DoubleLtOp) of (_,n) -> (SLIT("<##"), n),
316 case (primOpNameInfo DoubleLeOp) of (_,n) -> (SLIT("<=##"), n)]
327 mutableArrayPrimTyCon,
328 mutableByteArrayPrimTyCon,
338 swizzle_over (mod, nm, key, arity, is_data)
340 fname = mkPreludeCoreName mod nm
342 (nm, PreludeTyCon key fname arity is_data)
345 [--(pRELUDE_IO, SLIT("Request"), requestTyConKey, 0, True),
346 --OLD: (pRELUDE_IO, SLIT("Response"), responseTyConKey, 0, True),
347 (pRELUDE_IO, SLIT("Dialogue"), dialogueTyConKey, 0, False),
348 (SLIT("PreludeMonadicIO"), SLIT("IO"), iOTyConKey, 1, False)
351 -- Several of these are non-std, but they have non-std
352 -- names, so they won't get past the parser in user code
353 -- (but will be visible for interface-pragma purposes).
367 -- mutableArrayTyCon,
368 -- mutableByteArrayTyCon,
371 returnIntAndGMPTyCon,
373 stateAndAddrPrimTyCon,
374 stateAndArrayPrimTyCon,
375 stateAndByteArrayPrimTyCon,
376 stateAndCharPrimTyCon,
377 stateAndDoublePrimTyCon,
378 stateAndFloatPrimTyCon,
379 stateAndIntPrimTyCon,
380 stateAndMallocPtrPrimTyCon,
381 stateAndMutableArrayPrimTyCon,
382 stateAndMutableByteArrayPrimTyCon,
383 stateAndSynchVarPrimTyCon,
384 stateAndPtrPrimTyCon,
385 stateAndStablePtrPrimTyCon,
386 stateAndWordPrimTyCon,
391 #endif {- Data Parallel Haskell -}
402 swizzle_over (str, key)
403 = (str, PreludeClass key (mkPreludeCoreName pRELUDE_CORE str))
406 [(SLIT("Eq"), eqClassKey),
407 (SLIT("Ord"), ordClassKey),
408 (SLIT("Num"), numClassKey),
409 (SLIT("Real"), realClassKey),
410 (SLIT("Integral"), integralClassKey),
411 (SLIT("Fractional"), fractionalClassKey),
412 (SLIT("Floating"), floatingClassKey),
413 (SLIT("RealFrac"), realFracClassKey),
414 (SLIT("RealFloat"), realFloatClassKey),
415 (SLIT("Ix"), ixClassKey),
416 (SLIT("Enum"), enumClassKey),
417 (SLIT("Text"), textClassKey),
418 (SLIT("_CCallable"), cCallableClassKey),
419 (SLIT("_CReturnable"), cReturnableClassKey),
420 (SLIT("Binary"), binaryClassKey)
422 , (SLIT("Pid"), pidClassKey)
423 , (SLIT("Processor"),processorClassKey)
424 #endif {- Data Parallel Haskell -}
543 NewByteArrayOp CharKind,
544 NewByteArrayOp IntKind,
545 NewByteArrayOp AddrKind,
546 NewByteArrayOp FloatKind,
547 NewByteArrayOp DoubleKind,
549 SameMutableByteArrayOp,
553 ReadByteArrayOp CharKind,
554 ReadByteArrayOp IntKind,
555 ReadByteArrayOp AddrKind,
556 ReadByteArrayOp FloatKind,
557 ReadByteArrayOp DoubleKind,
558 WriteByteArrayOp CharKind,
559 WriteByteArrayOp IntKind,
560 WriteByteArrayOp AddrKind,
561 WriteByteArrayOp FloatKind,
562 WriteByteArrayOp DoubleKind,
563 IndexByteArrayOp CharKind,
564 IndexByteArrayOp IntKind,
565 IndexByteArrayOp AddrKind,
566 IndexByteArrayOp FloatKind,
567 IndexByteArrayOp DoubleKind,
568 IndexOffAddrOp CharKind,
569 IndexOffAddrOp IntKind,
570 IndexOffAddrOp AddrKind,
571 IndexOffAddrOp FloatKind,
572 IndexOffAddrOp DoubleKind,
574 UnsafeFreezeByteArrayOp,
583 ReallyUnsafePtrEqualityOp,
598 readUnfoldingPrimOp :: FAST_STRING -> PrimOp
602 -- "reverse" lookup table
603 tbl = map (\ o -> let { (str,_) = primOpNameInfo o } in (str, o)) lots_of_primops
605 \ str -> case [ op | (s, op) <- tbl, s == str ] of
608 [] -> panic "readUnfoldingPrimOp" -- ++ _UNPK_ str ++"::"++show (map fst tbl))
612 Make table entries for various things:
614 pcTyConNameInfo :: TyCon -> (FAST_STRING, Name)
615 pcTyConNameInfo tycon
616 = (getOccurrenceName tycon, WiredInTyCon tycon)
618 pcDataConNameInfo :: TyCon -> [(FAST_STRING, Name)]
619 pcDataConNameInfo tycon
620 = -- slurp out its data constructors...
621 [(getOccurrenceName con, WiredInVal con) | con <- getTyConDataCons tycon]