- mk name mod fs = (name, mod, fs)
-
- tups = map mk_tup [2..3]
- mk_tup n = mk (tyConName $ tupleTyCon Boxed n)
- nDP_INSTANCES
- (mkFastString $ "dPA_" ++ show n)
-
-initBuiltinPRs = initBuiltinDicts builtinPRs
-
-builtinPRs :: [(Name, Module, FastString)]
-builtinPRs = [
- mk (tyConName unitTyCon) nDP_PARRAY FSLIT("dPR_Unit")
- , mk ndpCrossTyConName nDP_PARRAY FSLIT("dPR_Cross")
- , mk ndpPlusTyConName nDP_PARRAY FSLIT("dPR_Plus")
- , mk embedTyConName nDP_PARRAY FSLIT("dPR_Embed")
- , mk closureTyConName nDP_CLOSURE FSLIT("dPR_Clo")
-
- -- temporary
- , mk intTyConName nDP_INSTANCES FSLIT("dPR_Int")
- ]
+ mk = (,,,)
+ mk' mod v v' = mk mod (fsLit v) mod (fsLit v')
+
+ vars_Ord mod = [mk' mod "==" "eqV"
+ ,mk' mod "/=" "neqV"
+ ,mk' mod "<=" "leV"
+ ,mk' mod "<" "ltV"
+ ,mk' mod ">=" "geV"
+ ,mk' mod ">" "gtV"
+ ,mk' mod "min" "minV"
+ ,mk' mod "max" "maxV"
+ ,mk' mod "minimumP" "minimumPA"
+ ,mk' mod "maximumP" "maximumPA"
+ ,mk' mod "minIndexP" "minIndexPA"
+ ,mk' mod "maxIndexP" "maxIndexPA"
+ ]
+
+ vars_Num mod = [mk' mod "+" "plusV"
+ ,mk' mod "-" "minusV"
+ ,mk' mod "*" "multV"
+ ,mk' mod "negate" "negateV"
+ ,mk' mod "abs" "absV"
+ ,mk' mod "sumP" "sumPA"
+ ,mk' mod "productP" "productPA"
+ ]
+
+ vars_Fractional mod = [mk' mod "/" "divideV"
+ ,mk' mod "recip" "recipV"
+ ]
+
+ vars_Floating mod = [mk' mod "pi" "pi"
+ ,mk' mod "exp" "expV"
+ ,mk' mod "sqrt" "sqrtV"
+ ,mk' mod "log" "logV"
+ ,mk' mod "sin" "sinV"
+ ,mk' mod "tan" "tanV"
+ ,mk' mod "cos" "cosV"
+ ,mk' mod "asin" "asinV"
+ ,mk' mod "atan" "atanV"
+ ,mk' mod "acos" "acosV"
+ ,mk' mod "sinh" "sinhV"
+ ,mk' mod "tanh" "tanhV"
+ ,mk' mod "cosh" "coshV"
+ ,mk' mod "asinh" "asinhV"
+ ,mk' mod "atanh" "atanhV"
+ ,mk' mod "acosh" "acoshV"
+ ,mk' mod "**" "powV"
+ ,mk' mod "logBase" "logBaseV"
+ ]
+
+ vars_RealFrac mod = [mk' mod "fromInt" "fromIntV"
+ ,mk' mod "truncate" "truncateV"
+ ,mk' mod "round" "roundV"
+ ,mk' mod "ceiling" "ceilingV"
+ ,mk' mod "floor" "floorV"
+ ]
+
+initBuiltinTyCons :: Builtins -> DsM [(Name, TyCon)]
+initBuiltinTyCons bi
+ = do
+ -- parr <- externalTyCon dph_Prelude_PArr (fsLit "PArr")
+ dft_tcs <- defaultTyCons
+ return $ (tyConName funTyCon, closureTyCon bi)
+ : (parrTyConName, parrayTyCon bi)
+
+ -- FIXME: temporary
+ : (tyConName $ parrayTyCon bi, parrayTyCon bi)
+
+ : [(tyConName tc, tc) | tc <- dft_tcs]
+
+defaultTyCons :: DsM [TyCon]
+defaultTyCons
+ = do
+ word8 <- dsLookupTyCon word8TyConName
+ return [intTyCon, boolTyCon, doubleTyCon, word8]
+
+initBuiltinDataCons :: Builtins -> [(Name, DataCon)]
+initBuiltinDataCons _ = [(dataConName dc, dc)| dc <- defaultDataCons]
+
+defaultDataCons :: [DataCon]
+defaultDataCons = [trueDataCon, falseDataCon, unitDataCon]
+
+initBuiltinPAs :: Builtins -> (InstEnv, InstEnv) -> DsM [(Name, Var)]
+initBuiltinPAs (Builtins { dphModules = mods }) insts
+ = liftM (initBuiltinDicts insts) (externalClass (dph_PArray mods) (fsLit "PA"))
+
+initBuiltinPRs :: Builtins -> (InstEnv, InstEnv) -> DsM [(Name, Var)]
+initBuiltinPRs (Builtins { dphModules = mods }) insts
+ = liftM (initBuiltinDicts insts) (externalClass (dph_PArray mods) (fsLit "PR"))
+
+initBuiltinDicts :: (InstEnv, InstEnv) -> Class -> [(Name, Var)]
+initBuiltinDicts insts cls = map find $ classInstances insts cls