diff --git a/DDC/Core/Lite/Compounds.hs b/DDC/Core/Lite/Compounds.hs --- a/DDC/Core/Lite/Compounds.hs +++ b/DDC/Core/Lite/Compounds.hs @@ -8,9 +8,8 @@ , tList) where import DDC.Core.Lite.Name +import DDC.Core.Compounds import DDC.Core.Exp -import DDC.Core.DaCon -import DDC.Type.Compounds -- Bools ---------------------------------------------------------------------- diff --git a/DDC/Core/Lite/Convert.hs b/DDC/Core/Lite/Convert.hs --- a/DDC/Core/Lite/Convert.hs +++ b/DDC/Core/Lite/Convert.hs @@ -375,14 +375,11 @@ xs' <- mapM (convertExpX ExpFun pp defs kenv tenv') xs return $ LRec $ zip bs' xs' - LLet LetStrict b x1 + LLet b x1 -> do let tenv' = Env.extend b tenv b' <- convertB kenv b x1' <- convertExpX ExpBind pp defs kenv tenv' x1 - return $ LLet LetStrict b' x1' - - LLet LetLazy{} _ _ - -> throw $ ErrorMalformed "XLet lazy not handled yet" + return $ LLet b' x1' LLetRegions b bs -> do b' <- mapM (convertB kenv) b @@ -398,18 +395,18 @@ -- | Convert a witness expression to Salt convertWitnessX :: Show a - => KindEnv L.Name -- ^ Kind enviornment - -> Witness L.Name -- ^ Witness to convert. - -> ConvertM a (Witness S.Name) + => KindEnv L.Name -- ^ Kind enviornment + -> Witness (AnTEC a L.Name) L.Name -- ^ Witness to convert. + -> ConvertM a (Witness a S.Name) convertWitnessX kenv ww = let down = convertWitnessX kenv in case ww of - WVar n -> liftM WVar (convertU n) - WCon wc -> liftM WCon (convertWiConX kenv wc) - WApp w1 w2 -> liftM2 WApp (down w1) (down w2) - WJoin w1 w2 -> liftM2 WApp (down w1) (down w2) - WType t -> liftM WType (convertT kenv t) + WVar a n -> liftM (WVar $ annotTail a) (convertU n) + WCon a wc -> liftM (WCon $ annotTail a) (convertWiConX kenv wc) + WApp a w1 w2 -> liftM2 (WApp $ annotTail a) (down w1) (down w2) + WJoin a w1 w2 -> liftM2 (WApp $ annotTail a) (down w1) (down w2) + WType a t -> liftM (WType $ annotTail a) (convertT kenv t) convertWiConX diff --git a/DDC/Core/Lite/Convert/Data.hs b/DDC/Core/Lite/Convert/Data.hs --- a/DDC/Core/Lite/Convert/Data.hs +++ b/DDC/Core/Lite/Convert/Data.hs @@ -58,14 +58,14 @@ -- Statements to write each of the fields. let xObject' = XVar a $ UIx 0 let lsFields - = [ LLet LetStrict (BNone O.tVoid) + = [ LLet (BNone O.tVoid) (O.xSetFieldOfBoxed a rPrime trField xObject' ix (liftX 1 xField)) | ix <- [0..] | xField <- xsFields | trField <- tsFields ] - return $ XLet a (LLet LetStrict bObject xAlloc) + return $ XLet a (LLet bObject xAlloc) $ foldr (XLet a) xObject' lsFields @@ -96,15 +96,15 @@ -- Statements to write each of the fields. let xObject' = XVar a $ UIx 1 let xPayload' = XVar a $ UIx 0 - let lsFields = [ LLet LetStrict (BNone O.tVoid) + let lsFields = [ LLet (BNone O.tVoid) (O.xPokeBuffer a rPrime tField xPayload' offset (liftX 2 xField)) | tField <- tsFields | offset <- offsets | xField <- xsFields] - return $ XLet a (LLet LetStrict bObject xAlloc) - $ XLet a (LLet LetStrict bPayload xPayload) + return $ XLet a (LLet bObject xAlloc) + $ XLet a (LLet bPayload xPayload) $ foldr (XLet a) xObject' lsFields | otherwise @@ -140,7 +140,7 @@ = catMaybes $ [ if isBNone bField then Nothing - else Just $ LLet LetStrict bField + else Just $ LLet bField (O.xGetFieldOfBoxed a trPrime tField (XVar a uScrut) ix) | bField <- bsFields @@ -162,7 +162,7 @@ = catMaybes $ [ if isBNone bField then Nothing - else Just $ LLet LetStrict bField + else Just $ LLet bField (O.xPeekBuffer a trPrime tField (XVar a uPayload) offset) | bField <- bsFields @@ -170,7 +170,7 @@ | offset <- offsets ] return $ foldr (XLet a) xBody - $ LLet LetStrict bPayload xPayload + $ LLet bPayload xPayload : lsFields diff --git a/DDC/Core/Lite/Convert/Type.hs b/DDC/Core/Lite/Convert/Type.hs --- a/DDC/Core/Lite/Convert/Type.hs +++ b/DDC/Core/Lite/Convert/Type.hs @@ -98,7 +98,7 @@ -- Convert applications. TApp{} -- Strip off effect and closure information. - | Just (t1, _, _, t2) <- takeTFun tt + | Just (t1, _, _, t2) <- takeTFunEC tt -> liftM2 tFunPE (down t1) (down t2) -- Witness application are passed through to Salt. @@ -136,7 +136,7 @@ TyConWitness c -> return $ TCon $ TyConWitness c -- Handle baked-in unit and function constructors. - TyConSpec TcConFun -> return $ TCon $ TyConSpec TcConFun + TyConSpec TcConFunEC -> return $ TCon $ TyConSpec TcConFunEC TyConSpec TcConUnit -> return $ O.tPtr O.rTop O.tObj -- Convert primitive unboxed TyCons to Salt form. diff --git a/DDC/Core/Lite/Env.hs b/DDC/Core/Lite/Env.hs --- a/DDC/Core/Lite/Env.hs +++ b/DDC/Core/Lite/Env.hs @@ -182,21 +182,21 @@ -- B# NamePrimDaCon PrimDaConBoolU -> Just $ tForall kRegion $ \tR - -> tFun tBoolU (tAlloc tR) + -> tFunEC tBoolU (tAlloc tR) (tBot kClosure) $ tBool tR -- N# NamePrimDaCon PrimDaConNatU -> Just $ tForall kRegion $ \tR - -> tFun tNatU (tAlloc tR) + -> tFunEC tNatU (tAlloc tR) (tBot kClosure) $ tNat tR -- I# NamePrimDaCon PrimDaConIntU -> Just $ tForall kRegion $ \tR - -> tFun tIntU (tAlloc tR) + -> tFunEC tIntU (tAlloc tR) (tBot kClosure) $ tInt tR @@ -207,24 +207,24 @@ -- Pair NamePrimDaCon PrimDaConPr -> Just $ tForalls [kRegion, kData, kData] $ \[tR, tA, tB] - -> tFun tA (tBot kEffect) + -> tFunEC tA (tBot kEffect) (tBot kClosure) - $ tFun tB (tSum kEffect [tAlloc tR]) + $ tFunEC tB (tSum kEffect [tAlloc tR]) (tSum kClosure [tDeepUse tA]) $ tPair tR tA tB -- List NamePrimDaCon PrimDaConNil -> Just $ tForalls [kRegion, kData] $ \[tR, tA] - -> tFun tUnit (tAlloc tR) - (tBot kClosure) + -> tFunEC tUnit (tAlloc tR) + (tBot kClosure) $ tList tR tA NamePrimDaCon PrimDaConCons -> Just $ tForalls [kRegion, kData] $ \[tR, tA] - -> tFun tA (tBot kEffect) + -> tFunEC tA (tBot kEffect) (tBot kClosure) - $ tFun (tList tR tA) (tSum kEffect [tAlloc tR]) + $ tFunEC (tList tR tA) (tSum kEffect [tAlloc tR]) (tSum kClosure [tDeepUse tA]) $ tList tR tA @@ -251,6 +251,7 @@ PrimArithSub -> tForall kData $ \t -> t `tFunPE` t `tFunPE` t PrimArithMul -> tForall kData $ \t -> t `tFunPE` t `tFunPE` t PrimArithDiv -> tForall kData $ \t -> t `tFunPE` t `tFunPE` t + PrimArithMod -> tForall kData $ \t -> t `tFunPE` t `tFunPE` t PrimArithRem -> tForall kData $ \t -> t `tFunPE` t `tFunPE` t -- Comparison diff --git a/DDC/Core/Lite/Profile.hs b/DDC/Core/Lite/Profile.hs --- a/DDC/Core/Lite/Profile.hs +++ b/DDC/Core/Lite/Profile.hs @@ -10,6 +10,7 @@ import DDC.Core.Fragment import DDC.Core.Lexer import DDC.Data.Token +import qualified DDC.Type.Env as Env -- | Profile for Disciple Core Lite. @@ -19,6 +20,7 @@ { profileName = "Lite" , profileFeatures = features , profilePrimDataDefs = primDataDefs + , profilePrimSupers = Env.empty , profilePrimKinds = primKindEnv , profilePrimTypes = primTypeEnv @@ -30,13 +32,14 @@ features :: Features features = Features - { featuresUntrackedEffects = False - , featuresUntrackedClosures = False + { featuresTrackedEffects = True + , featuresTrackedClosures = True + , featuresFunctionalEffects = True + , featuresFunctionalClosures = True , featuresPartialPrims = False , featuresPartialApplication = True , featuresGeneralApplication = True , featuresNestedFunctions = True - , featuresLazyBindings = True , featuresDebruijnBinders = True , featuresUnboundLevel0Vars = False diff --git a/DDC/Core/Salt/Compounds.hs b/DDC/Core/Salt/Compounds.hs --- a/DDC/Core/Salt/Compounds.hs +++ b/DDC/Core/Salt/Compounds.hs @@ -13,8 +13,7 @@ where import DDC.Core.Salt.Name import DDC.Core.Exp -import DDC.Core.DaCon -import DDC.Type.Compounds +import DDC.Core.Compounds -- Types ---------------------------------------------------------------------- diff --git a/DDC/Core/Salt/Convert.hs b/DDC/Core/Salt/Convert.hs --- a/DDC/Core/Salt/Convert.hs +++ b/DDC/Core/Salt/Convert.hs @@ -303,7 +303,7 @@ [ xx' <> semi ] -- Binding from a case-expression. - XLet _ (LLet LetStrict b x1@XCase{}) x2 + XLet _ (LLet b x1@XCase{}) x2 -> do -- Convert the right hand side in a nested context. -- The ContextNext holds the var to assign the result to. @@ -318,7 +318,7 @@ , x2' ] -- Binding from an r-value. - XLet _ (LLet LetStrict b x1) x2 + XLet _ (LLet b x1) x2 -> do x1' <- convRValueM pp kenv tenv x1 x2' <- convBlockM context pp kenv tenv x2 diff --git a/DDC/Core/Salt/Convert/Init.hs b/DDC/Core/Salt/Convert/Init.hs --- a/DDC/Core/Salt/Convert/Init.hs +++ b/DDC/Core/Salt/Convert/Init.hs @@ -42,8 +42,8 @@ -- Initial size of the heap. bytes = configHeapSize config - xMain' = hackBodyX (XLet a (LLet LetStrict (BNone tVoid) - (xCreate a bytes))) + xMain' = hackBodyX (XLet a (LLet (BNone tVoid) + (xCreate a bytes))) xMain in Just $ XLet a (LRec $ bxs_cut ++ [(bMain, xMain')]) x2 diff --git a/DDC/Core/Salt/Convert/Prim.hs b/DDC/Core/Salt/Convert/Prim.hs --- a/DDC/Core/Salt/Convert/Prim.hs +++ b/DDC/Core/Salt/Convert/Prim.hs @@ -35,7 +35,8 @@ PrimArithSub -> Just $ text "-" PrimArithMul -> Just $ text "*" PrimArithDiv -> Just $ text "/" - PrimArithRem -> Just $ text "%" + PrimArithMod -> Just $ text "_MOD" + PrimArithRem -> Just $ text "_REM" -- comparison PrimArithEq -> Just $ text "==" diff --git a/DDC/Core/Salt/Env.hs b/DDC/Core/Salt/Env.hs --- a/DDC/Core/Salt/Env.hs +++ b/DDC/Core/Salt/Env.hs @@ -4,7 +4,10 @@ ( primDataDefs , primKindEnv , primTypeEnv + , typeOfPrimArith + , typeOfPrimCast , typeOfPrimCall + , typeOfPrimControl , typeOfPrimStore , typeIsUnboxed) where @@ -138,6 +141,7 @@ PrimArithSub -> tForall kData $ \t -> t `tFunPE` t `tFunPE` t PrimArithMul -> tForall kData $ \t -> t `tFunPE` t `tFunPE` t PrimArithDiv -> tForall kData $ \t -> t `tFunPE` t `tFunPE` t + PrimArithMod -> tForall kData $ \t -> t `tFunPE` t `tFunPE` t PrimArithRem -> tForall kData $ \t -> t `tFunPE` t `tFunPE` t -- Comparison diff --git a/DDC/Core/Salt/Name.hs b/DDC/Core/Salt/Name.hs --- a/DDC/Core/Salt/Name.hs +++ b/DDC/Core/Salt/Name.hs @@ -5,6 +5,7 @@ -- * Primitive Type Constructors , PrimTyCon (..) + , readPrimTyCon , primTyConIsIntegral , primTyConIsFloating , primTyConIsUnsigned @@ -15,16 +16,27 @@ , PrimOp (..) , PrimArith (..) + , readPrimArith , PrimCast (..) + , readPrimCast , primCastPromoteIsValid , primCastTruncateIsValid , PrimStore (..) + , readPrimStore , PrimCall (..) + , readPrimCall , PrimControl (..) + , readPrimControl + + -- * Primitive Literals + , readLitInteger + , readLitPrimNat + , readLitPrimInt + , readLitPrimWordOfBits -- * Name Parsing , readName diff --git a/DDC/Core/Salt/Name/PrimOp.hs b/DDC/Core/Salt/Name/PrimOp.hs --- a/DDC/Core/Salt/Name/PrimOp.hs +++ b/DDC/Core/Salt/Name/PrimOp.hs @@ -74,6 +74,7 @@ | PrimArithSub -- ^ Subtraction | PrimArithMul -- ^ Multiplication | PrimArithDiv -- ^ Division + | PrimArithMod -- ^ Modulus | PrimArithRem -- ^ Remainder -- comparison @@ -121,6 +122,7 @@ , (PrimArithMul, "mul#") , (PrimArithDiv, "div#") , (PrimArithRem, "rem#") + , (PrimArithMod, "mod#") , (PrimArithEq , "eq#" ) , (PrimArithNeq, "neq#") , (PrimArithGt , "gt#" ) diff --git a/DDC/Core/Salt/Profile.hs b/DDC/Core/Salt/Profile.hs --- a/DDC/Core/Salt/Profile.hs +++ b/DDC/Core/Salt/Profile.hs @@ -10,6 +10,7 @@ import DDC.Core.Fragment import DDC.Core.Lexer import DDC.Data.Token +import qualified DDC.Type.Env as Env -- | Language profile for Disciple Core Salt. @@ -19,6 +20,7 @@ { profileName = "Salt" , profileFeatures = features , profilePrimDataDefs = primDataDefs + , profilePrimSupers = Env.empty , profilePrimKinds = primKindEnv , profilePrimTypes = primTypeEnv , profileTypeIsUnboxed = typeIsUnboxed } @@ -28,8 +30,8 @@ -- No nested functions, no partial application and so on. features :: Features features = zeroFeatures - { featuresUntrackedEffects = True - , featuresUntrackedClosures = True + { featuresFunctionalEffects = True + , featuresFunctionalClosures = True , featuresDebruijnBinders = True , featuresUnusedBindings = True } diff --git a/DDC/Core/Salt/Transfer.hs b/DDC/Core/Salt/Transfer.hs --- a/DDC/Core/Salt/Transfer.hs +++ b/DDC/Core/Salt/Transfer.hs @@ -141,7 +141,7 @@ transL tails lts = case lts of - LLet mode b x -> LLet mode b (transX tails x) + LLet b x -> LLet b (transX tails x) LRec bxs -> LRec [(b, transX tails x) | (b, x) <- bxs] LLetRegions{} -> lts LWithRegion{} -> lts diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- The Disciplined Disciple Compiler License (MIT style) -Copyrite (K) 2007-2012 The Disciplined Disciple Compiler Strike Force +Copyrite (K) 2007-2013 The Disciplined Disciple Compiler Strike Force All rights reversed. Permission is hereby granted, free of charge, to any person obtaining a copy diff --git a/ddc-core-salt.cabal b/ddc-core-salt.cabal --- a/ddc-core-salt.cabal +++ b/ddc-core-salt.cabal @@ -1,5 +1,5 @@ Name: ddc-core-salt -Version: 0.3.1.1 +Version: 0.3.2.1 License: MIT License-file: LICENSE Author: The Disciplined Disciple Compiler Strike Force @@ -9,7 +9,6 @@ Stability: experimental Category: Compilers/Interpreters Homepage: http://disciple.ouroborus.net -Bug-reports: disciple@ouroborus.net Synopsis: Disciplined Disciple Compiler C code generator. Description: Disciplined Disciple Compiler C code generator. @@ -21,8 +20,8 @@ array == 0.4.*, transformers == 0.3.*, mtl == 2.1.*, - ddc-base == 0.3.1.*, - ddc-core == 0.3.1.* + ddc-base == 0.3.2.*, + ddc-core == 0.3.2.* Exposed-modules: DDC.Core.Salt.Transfer