diff --git a/DDC/Core/Eval.hs b/DDC/Core/Eval.hs --- a/DDC/Core/Eval.hs +++ b/DDC/Core/Eval.hs @@ -6,10 +6,13 @@ -- evaluator will have an asymptotic complexity much worse than if they were -- compiled. This evaluator is intended for experimenting with the language -- semantics, and not running actual programs. +-- module DDC.Core.Eval - ( StepResult (..) + ( evalProfile + , StepResult (..) , force , step) where +import DDC.Core.Eval.Profile import DDC.Core.Eval.Step diff --git a/DDC/Core/Eval/Check.hs b/DDC/Core/Eval/Check.hs --- a/DDC/Core/Eval/Check.hs +++ b/DDC/Core/Eval/Check.hs @@ -1,23 +1,37 @@ +-- | Check for conflicting store capabilities in the initial program. module DDC.Core.Eval.Check - ( checkCapsX + ( checkCapsModule + , checkCapsX , Error(..)) where import DDC.Core.Eval.Compounds import DDC.Core.Eval.Name +import DDC.Core.Module import DDC.Core.Exp +import DDC.Core.Compounds import DDC.Base.Pretty import Control.Monad import Data.Maybe -import DDC.Type.Check.Monad (throw, result) -import Data.Set (Set) -import qualified DDC.Type.Check.Monad as G -import qualified Data.Set as Set +import Data.Set (Set) +import DDC.Control.Monad.Check (throw, result) +import qualified DDC.Control.Monad.Check as G +import qualified Data.Set as Set -type CheckM a = G.CheckM Error --- | Check for conflicting store capabilities in the program. -checkCapsX :: Exp a Name -> Maybe Error +-- | Capability Checking monad. +type CheckM a x + = G.CheckM (Error a) x + + +-- | Check for conflicting store capabilities in a module. +checkCapsModule :: Module a Name -> Maybe (Error a) +checkCapsModule mm + = checkCapsX $ moduleBody mm + + +-- | Check for conflicting store capabilities in an expression. +checkCapsX :: Exp a Name -> Maybe (Error a) checkCapsX xx = case result $ checkCapsXM xx of Left err -> Just err @@ -27,15 +41,18 @@ -- CapSet -------------------------------------------------------------------- +-- | Set of used capabilities. data CapSet = CapSet { capsGlobal :: Set Rgn , capsConst :: Set Rgn , capsMutable :: Set Rgn + , capsDistinct :: Set [Rgn] , capsLazy :: Set Rgn , capsManifest :: Set Rgn } deriving Show + -- | An empty capability set emptyCapSet :: CapSet emptyCapSet @@ -43,6 +60,7 @@ { capsGlobal = Set.empty , capsConst = Set.empty , capsMutable = Set.empty + , capsDistinct = Set.empty , capsLazy = Set.empty , capsManifest = Set.empty } @@ -50,8 +68,8 @@ -- | Insert a capability, or `error` if this isn't one. mustInsertCap :: Witness Name -> CapSet -> CapSet mustInsertCap ww caps - | WApp (WCon (WiConBound (UPrim nc _))) - (WType (TCon (TyConBound (UPrim nh _)))) <- ww + | WApp (WCon (WiConBound (UPrim nc _) _)) + (WType (TCon (TyConBound (UPrim nh _) _))) <- ww , NameCap c <- nc , NameRgn r <- nh = case c of @@ -60,13 +78,25 @@ CapMutable -> caps { capsMutable = Set.insert r (capsMutable caps) } CapLazy -> caps { capsLazy = Set.insert r (capsLazy caps) } CapManifest -> caps { capsManifest = Set.insert r (capsManifest caps)} - + _ -> error "mustInsertCap: invalid witness application" + + | Just (NameCap (CapDistinct _), ws) <- takePrimWiConApps ww + , ws' <- map takeNameRgn ws + , all isJust ws' + = caps { capsDistinct = Set.insert (catMaybes ws') (capsDistinct caps) } + | otherwise = error "mustInsertCap: not a capability" +-- | Take a region name from a witness argument. +takeNameRgn :: Witness Name -> Maybe Rgn +takeNameRgn (WType (TCon (TyConBound (UPrim (NameRgn r) _) _))) = Just r +takeNameRgn _ = Nothing + + -- | Check a capability set for conflicts between the capabilities. -checkCapSet :: CapSet -> Maybe Error +checkCapSet :: CapSet -> Maybe (Error a) checkCapSet cs | r : _ <- Set.toList $ Set.intersection (capsConst cs) (capsMutable cs) @@ -82,7 +112,7 @@ -- Error ---------------------------------------------------------------------- -- | Things that can go wrong with the capabilities in a program. -data Error +data Error a -- | Conflicting capabilities in program. = ErrorConflict { errorRegions :: Rgn @@ -105,7 +135,7 @@ { errorWitness :: Witness Name } -instance Pretty Error where +instance Pretty (Error a) where ppr err = case err of ErrorConflict r c1 c2 @@ -143,23 +173,30 @@ XWitness w -> checkCapsWM w -checkCapsCM :: Cast Name -> CheckM a [Witness Name] +checkCapsCM :: Cast a Name -> CheckM a [Witness Name] checkCapsCM cc = let none = return [] in case cc of - CastWeakenEffect{} -> none - CastWeakenClosure{} -> none - CastPurify w -> checkCapsWM w - CastForget w -> checkCapsWM w + CastWeakenEffect{} + -> none + CastWeakenClosure xs + -> liftM concat $ mapM checkCapsXM xs + CastPurify w + -> checkCapsWM w + + CastForget w + -> checkCapsWM w + + checkCapsLM :: Lets a Name -> CheckM a [Witness Name] checkCapsLM ll = let none = return [] in case ll of LLet m _ x -> liftM2 (++) (checkCapsMM m) (checkCapsXM x) LRec bxs -> liftM concat (mapM checkCapsXM $ map snd bxs) - LLetRegion{} -> none + LLetRegions{} -> none LWithRegion{} -> none diff --git a/DDC/Core/Eval/Compounds.hs b/DDC/Core/Eval/Compounds.hs --- a/DDC/Core/Eval/Compounds.hs +++ b/DDC/Core/Eval/Compounds.hs @@ -3,58 +3,61 @@ -- expressions. module DDC.Core.Eval.Compounds ( -- * Types - tUnit - , tInt - , tPair + tPair , tList -- * Witnesses , wGlobal , wConst, wMutable + , wDistinct , wLazy, wManifest , wcGlobal , wcConst, wcMutable + , wcDistinct , wcLazy, wcManifest , isCapConW -- * Expressions + , takeMutableX + + -- * Units + , xUnit , isUnitX + + -- * Region Handles , takeHandleT , takeHandleX - , takeLocX, stripLocX - , takeMutableX) + + -- * Store Locations. + , xLoc, takeLocX, stripLocX + + -- * Integers + , tInt, tcInt + , dcInt + , takeIntDC, takeIntX) where import DDC.Core.Eval.Name import DDC.Type.Compounds +import DDC.Core.Compounds (wApps) import DDC.Core.Exp +import DDC.Core.DaCon -- Type ----------------------------------------------------------------------- --- | Application of the Unit type constructor. -tUnit :: Type Name -tUnit = TCon (TyConBound (UPrim (NamePrimCon PrimTyConUnit) kData)) - - --- | Application of the Int type constructor. -tInt :: Region Name -> Type Name -tInt r1 = TApp (TCon (TyConBound (UPrim (NamePrimCon PrimTyConInt) - (kFun kRegion kData)))) - r1 - -- | Application of the Pair type constructor. tPair :: Region Name -> Type Name -> Type Name -> Type Name tPair tR tA tB - = tApps (TCon (TyConBound (UPrim (NamePrimCon PrimTyConPair) - (kFuns [kRegion, kData, kData] kData)))) - [tR, tA, tB] + = tApps (TCon tcPair) [tR, tA, tB] + where tcPair = TyConBound (UPrim (NamePrimCon PrimTyConPair) kPair) kPair + kPair = kFuns [kRegion, kData, kData] kData -- | Application of the List type constructor. tList :: Region Name -> Type Name -> Type Name tList tR tA - = tApps (TCon (TyConBound (UPrim (NamePrimCon PrimTyConList) - (kRegion `kFun` kData `kFun` kData)))) - [tR, tA] + = tApps (TCon tcList) [tR, tA] + where tcList = TyConBound (UPrim (NamePrimCon PrimTyConList) kList) kList + kList = kRegion `kFun` kData `kFun` kData -- Witness -------------------------------------------------------------------- @@ -73,52 +76,66 @@ wManifest :: Region Name -> Witness Name wManifest r = WApp (WCon wcManifest) (WType r) +wDistinct :: Int -> [Region Name] -> Witness Name +wDistinct n rs = wApps (WCon (wcDistinct n)) (map WType rs) -- Just the Constructors wcGlobal :: WiCon Name -wcGlobal = WiConBound - $ UPrim (NameCap CapGlobal) (tForall kRegion $ \r -> tGlobal r) +wcGlobal = WiConBound (UPrim (NameCap CapGlobal) t) t + where t = tForall kRegion $ \r -> tGlobal r wcConst :: WiCon Name -wcConst = WiConBound - $ UPrim (NameCap CapConst) (tForall kRegion $ \r -> tConst r) +wcConst = WiConBound (UPrim (NameCap CapConst) t) t + where t = tForall kRegion $ \r -> tConst r wcMutable :: WiCon Name -wcMutable = WiConBound - $ UPrim (NameCap CapMutable) (tForall kRegion $ \r -> tMutable r) - +wcMutable = WiConBound (UPrim (NameCap CapMutable) t) t + where t = tForall kRegion $ \r -> tMutable r + wcLazy :: WiCon Name -wcLazy = WiConBound - $ UPrim (NameCap CapLazy) (tForall kRegion $ \r -> tLazy r) +wcLazy = WiConBound (UPrim (NameCap CapLazy) t) t + where t = tForall kRegion $ \r -> tLazy r wcManifest :: WiCon Name -wcManifest = WiConBound - $ UPrim (NameCap CapManifest) (tForall kRegion $ \r -> tManifest r) +wcManifest = WiConBound (UPrim (NameCap CapManifest) t) t + where t = tForall kRegion $ \r -> tManifest r +wcDistinct :: Int -> WiCon Name +wcDistinct n = WiConBound (UPrim (NameCap (CapDistinct n)) t) t + where t = tForalls (replicate n kRegion) $ \ts -> tDistinct n ts + -- | Check whether a witness is a capability constructor. isCapConW :: Witness Name -> Bool isCapConW ww = case ww of - WCon WiConBound{} -> True - _ -> False - + WCon WiConBound{} -> True + _ -> False -- Exp ------------------------------------------------------------------------ +-- | Make a unit literal. +xUnit :: Exp () Name +xUnit = XCon () $ dcUnit + + -- | Check whether an expression is the unit constructor. isUnitX :: Exp a Name -> Bool isUnitX xx = case xx of - XCon _ (UPrim (NamePrimCon PrimDaConUnit) _) -> True - _ -> False + XCon _ dc + -> case daConName dc of + DaConUnit -> True + _ -> False + _ -> False +-- Handles -------------------------------------- -- | Take a region handle from a type. takeHandleT :: Type Name -> Maybe Rgn takeHandleT tt = case tt of - TCon (TyConBound (UPrim (NameRgn r1) _)) + TCon (TyConBound (UPrim (NameRgn r1) _) _) -> Just r1 _ -> Nothing @@ -131,6 +148,13 @@ _ -> Nothing +-- Locations ------------------------------------ +-- | Make a location expression. +xLoc :: Loc -> Type Name -> Exp () Name +xLoc l t + = XCon () $ mkDaConSolid (NameLoc l) t + + -- | Take a store location from an expression. -- We strip off 'forget' casts along the way takeLocX :: Exp a Name -> Maybe Loc @@ -139,8 +163,11 @@ XCast _ (CastForget _) x -> takeLocX x - XCon _ (UPrim (NameLoc l) _) - -> Just l + XCon _ dc + -> case takeNameOfDaCon dc of + Just (NameLoc l) -> Just l + _ -> Nothing + _ -> Nothing @@ -151,20 +178,55 @@ XCast _ (CastForget _) x -> stripLocX x - XCon _ (UPrim (NameLoc l) _) - -> Just l + XCon _ dc + -> case takeNameOfDaCon dc of + Just (NameLoc l) -> Just l + _ -> Nothing + _ -> Nothing +-- Witnesses ------------------------------------ -- | Take a witness of mutability from an expression. takeMutableX :: Exp a Name -> Maybe Rgn takeMutableX xx = case xx of XWitness (WApp (WCon wc) (WType tR1)) - | WiConBound (UPrim (NameCap CapMutable) _) <- wc + | WiConBound (UPrim (NameCap CapMutable) _) _ <- wc -> takeHandleT tR1 _ -> Nothing +-- Integers ------------------------------------- +-- | Application of the Int type constructor. +tInt :: Region Name -> Type Name +tInt r1 + = TApp (TCon tcInt) r1 + +-- | The integer type constructor +tcInt :: TyCon Name +tcInt = TyConBound (UPrim (NamePrimCon PrimTyConInt) kInt) kInt + where kInt = kFun kRegion kData + + +-- | Make an integer data constructor. +dcInt :: Integer -> DaCon Name +dcInt i = mkDaConAlg (NameInt i) (TCon tcInt) + + +-- | Take an integer literal from an data constructor. +takeIntDC :: DaCon Name -> Maybe Integer +takeIntDC dc + = case takeNameOfDaCon dc of + Just (NameInt i) -> Just i + _ -> Nothing + + +-- | Take an integer literal from an expression. +takeIntX :: Exp a Name -> Maybe Integer +takeIntX xx + = case xx of + XCon _ dc -> takeIntDC dc + _ -> Nothing diff --git a/DDC/Core/Eval/Env.hs b/DDC/Core/Eval/Env.hs --- a/DDC/Core/Eval/Env.hs +++ b/DDC/Core/Eval/Env.hs @@ -19,7 +19,7 @@ where import DDC.Core.Eval.Compounds import DDC.Core.Eval.Name -import DDC.Core.DataDef +import DDC.Type.DataDef import DDC.Type.Exp import DDC.Type.Compounds import DDC.Type.Env (Env) @@ -31,33 +31,27 @@ -- -- @ Type Constructors -- ---- ------------ --- Unit () -- Int 0 1 2 3 ... +-- Pair Pr -- List Nil Cons -- @ primDataDefs :: DataDefs Name primDataDefs = fromListDataDefs - -- Unit - [ DataDef - (NamePrimCon PrimTyConUnit) - [] - (Just [ (NamePrimCon PrimDaConUnit, []) ]) - - -- Int - , DataDef + [ -- Int + DataDef (NamePrimCon PrimTyConInt) [kRegion] Nothing - -- Pair + -- Pair , DataDef (NamePrimCon PrimTyConPair) [kRegion, kData, kData] (Just [ ( NamePrimCon PrimDaConPr , [tIx kData 1, tIx kData 0]) ]) - -- List + -- List , DataDef (NamePrimCon PrimTyConList) [kRegion, kData] @@ -82,10 +76,6 @@ NameRgn _ -> Just $ kRegion - -- Unit - NamePrimCon PrimTyConUnit - -> Just $ kData - -- Int NamePrimCon PrimTyConInt -> Just $ kFun kRegion kData @@ -102,8 +92,6 @@ _ -> Nothing - - -- Types ---------------------------------------------------------------------- -- | Type environment containing types of primitive data constructors as well -- as the following primitive operators: @@ -125,10 +113,6 @@ typeOfPrimName :: Name -> Maybe (Type Name) typeOfPrimName nn = case nn of - -- Unit - NamePrimCon PrimDaConUnit - -> Just $ tUnit - -- Pair NamePrimCon PrimDaConPr -> Just $ tForalls [kRegion, kData, kData] $ \[tR, tA, tB] @@ -194,11 +178,12 @@ (tBot kClosure) $ (tInt r0) - NameCap CapGlobal -> Just $ tForall kRegion $ \r -> tGlobal r - NameCap CapConst -> Just $ tForall kRegion $ \r -> tConst r - NameCap CapMutable -> Just $ tForall kRegion $ \r -> tMutable r - NameCap CapLazy -> Just $ tForall kRegion $ \r -> tLazy r - NameCap CapManifest -> Just $ tForall kRegion $ \r -> tManifest r + NameCap CapGlobal -> Just $ tForall kRegion $ \r -> tGlobal r + NameCap CapConst -> Just $ tForall kRegion $ \r -> tConst r + NameCap CapMutable -> Just $ tForall kRegion $ \r -> tMutable r + NameCap CapLazy -> Just $ tForall kRegion $ \r -> tLazy r + NameCap CapManifest -> Just $ tForall kRegion $ \r -> tManifest r + NameCap (CapDistinct n) -> Just $ tForalls (replicate n kRegion) $ \rs -> tDistinct n rs _ -> Nothing @@ -206,7 +191,8 @@ -- | Take the arity of a primitive name. --- --- TODO: determine this from the type. +-- We could take this from the type of the primitive instead, +-- but doing it this way is easy enough. arityOfName :: Name -> Maybe Int arityOfName n = case n of @@ -214,7 +200,6 @@ NameRgn{} -> Just 0 NameInt{} -> Just 2 - NamePrimCon PrimDaConUnit -> Just 0 NamePrimCon PrimDaConPr -> Just 5 NamePrimCon PrimDaConNil -> Just 3 NamePrimCon PrimDaConCons -> Just 4 diff --git a/DDC/Core/Eval/Name.hs b/DDC/Core/Eval/Name.hs --- a/DDC/Core/Eval/Name.hs +++ b/DDC/Core/Eval/Name.hs @@ -7,14 +7,16 @@ , Rgn (..) , Cap (..) , readName - , lexString) + , lexModuleString + , lexExpString) where +import DDC.Core.Lexer import DDC.Base.Pretty -import DDC.Base.Lexer -import DDC.Core.Parser.Lexer -import DDC.Core.Parser.Tokens +import DDC.Data.Token +import Control.DeepSeq +import Data.Typeable import Data.Char -import Data.Maybe +import Data.List -- | Names of things recognised by the evaluator. @@ -33,10 +35,22 @@ | NameLoc Loc -- ^ Store locations. | NameRgn Rgn -- ^ Region handles. | NameCap Cap -- ^ Store capabilities. + deriving (Show, Eq, Ord, Typeable) - deriving (Show, Eq, Ord) - +instance NFData Name where + rnf nn + = case nn of + NameVar s -> rnf s + NameCon s -> rnf s + NameInt i -> rnf i + NamePrimCon pc -> rnf pc + NamePrimOp po -> rnf po + NameLoc l -> rnf l + NameRgn r -> rnf r + NameCap c -> rnf c + + instance Pretty Name where ppr nn = case nn of @@ -58,9 +72,13 @@ = Loc Int deriving (Eq, Ord, Show) + +instance NFData Loc where + rnf (Loc i) = rnf i + + instance Pretty Loc where - ppr (Loc l) - = text "L" <> text (show l) <> text "#" + ppr (Loc l) = text "L" <> text (show l) <> text "#" -- Regions -------------------------------------------------------------------- @@ -71,9 +89,11 @@ = Rgn Int deriving (Eq, Ord, Show) +instance NFData Rgn where + rnf (Rgn i) = rnf i + instance Pretty Rgn where - ppr (Rgn r) - = text "R" <> text (show r) <> text "#" + ppr (Rgn r) = text "R" <> text (show r) <> text "#" -- Capabilities -------------------------------------------------------------- @@ -87,36 +107,48 @@ -- deallocated in a stack like manner. This lets us hide the use of -- such regions, and rely on the garbage collector to reclaim the -- space. - = CapGlobal -- global :: [r: %]. Global r + = CapGlobal -- Global# :: [r: %]. Global r -- | Witness that a region is constant. -- This lets us purify read and allocation effects on it, -- and prevents it from being Mutable. - | CapConst -- const :: [r: %]. Const r + | CapConst -- Const# :: [r: %]. Const r -- | Witness that a region is mutable. -- This lets us update objects in the region, -- and prevents it from being Constant. - | CapMutable -- mutable :: [r: %]. Mutable r + | CapMutable -- Mutable# :: [r: %]. Mutable r + -- | Witness that some regions are distinct + -- This lets us perform aliasing based optimisations. + | CapDistinct Int -- Distinct2# :: [r1 r2 : %]. Distinct2 r1 r2 + -- | Witness that a region is lazy. -- This lets is allocate thunks into the region, -- and prevents it from being Manifest. - | CapLazy -- lazy :: [r: %].Lazy r + | CapLazy -- Lazy# :: [r: %].Lazy r -- | Witness that a region is manifest. -- This ensures there are no thunks in the region, -- which prevents it from being Lazy. - | CapManifest -- manifest :: [r: %]. Manifest r + | CapManifest -- Manifest# :: [r: %]. Manifest r deriving (Eq, Ord, Show) +instance NFData Cap where + rnf cap + = case cap of + CapDistinct i -> rnf i + _ -> () + + instance Pretty Cap where ppr cp = case cp of CapGlobal -> text "Global#" CapConst -> text "Const#" CapMutable -> text "Mutable#" + CapDistinct n -> text "Distinct" <> ppr n <> text "#" CapLazy -> text "Lazy#" CapManifest -> text "Manifest#" @@ -125,27 +157,25 @@ -- | A primitive constructor. data PrimCon -- Type constructors - = PrimTyConUnit -- ^ Unit type constructor (@Unit@). - | PrimTyConInt -- ^ @Int@ type constructor. + = PrimTyConInt -- ^ @Int@ type constructor. | PrimTyConPair -- ^ @Pair@ type constructor. | PrimTyConList -- ^ @List@ type constructor. -- Implement lists as primitives until we have data decls working - | PrimDaConUnit -- ^ Unit data constructor (@()@). | PrimDaConPr -- ^ @P@ data construct (pairs). | PrimDaConNil -- ^ @Nil@ data constructor. | PrimDaConCons -- ^ @Cons@ data constructor. deriving (Show, Eq, Ord) +instance NFData PrimCon + instance Pretty PrimCon where ppr con = case con of - PrimTyConUnit -> text "Unit" PrimTyConInt -> text "Int" PrimTyConPair -> text "Pair" PrimTyConList -> text "List" - PrimDaConUnit -> text "()" PrimDaConPr -> text "Pr" PrimDaConNil -> text "Nil" PrimDaConCons -> text "Cons" @@ -164,6 +194,7 @@ | PrimOpCopyInt deriving (Show, Eq, Ord) +instance NFData PrimOp instance Pretty PrimOp where ppr op @@ -183,7 +214,7 @@ readName :: String -> Maybe Name readName [] = Nothing readName str@(c:rest) - -- primops + -- primops and variables. | isLower c = case (c:rest) of "negInt" -> Just $ NamePrimOp PrimOpNegInt @@ -196,16 +227,16 @@ "copyInt" -> Just $ NamePrimOp PrimOpCopyInt _ -> Just $ NameVar str - -- units - | str == "Unit" = Just $ NamePrimCon PrimTyConUnit - | str == "()" = Just $ NamePrimCon PrimDaConUnit - -- integers | str == "Int" = Just $ NamePrimCon PrimTyConInt - | (ds, "") <- span isDigit str - = Just $ NameInt (read ds) + | c == '-' + , all isDigit rest + = Just $ NameInt (read str) + | all isDigit str + = Just $ NameInt (read str) + -- pairs | str == "Pair" = Just $ NamePrimCon PrimTyConPair | str == "Pr" = Just $ NamePrimCon PrimDaConPr @@ -233,6 +264,9 @@ | str == "Mutable#" = Just $ NameCap CapMutable | str == "Lazy#" = Just $ NameCap CapLazy | str == "Manifest#" = Just $ NameCap CapManifest + | Just n <- stripPrefix "Distinct" str + , n' <- read $ takeWhile ('#' /=) n + = Just $ NameCap (CapDistinct n') -- other constructors | isUpper c @@ -241,17 +275,30 @@ | otherwise = Nothing -readName_ :: String -> Name -readName_ str - = fromMaybe (error $ "can't rename token " ++ str) - $ readName str +-- | Lex a string to tokens, using primitive names. +-- +-- The first argument gives the starting source line number. +-- +lexModuleString :: String -> Int -> String -> [Token (Tok Name)] +lexModuleString sourceName lineStart str + = map rn $ lexModuleWithOffside sourceName lineStart str + where rn (Token strTok sp) + = case renameTok readName strTok of + Just t' -> Token t' sp + Nothing -> Token (KJunk "lexical error") sp + -- | Lex a string to tokens, using primitive names. -- -- The first argument gives the starting source line number. -lexString :: Int -> String -> [Token (Tok Name)] -lexString lineStart str - = map rn $ lexExp lineStart str - where rn (Token t sp) = Token (renameTok readName_ t) sp +-- +lexExpString :: String -> Int -> String -> [Token (Tok Name)] +lexExpString sourceName lineStart str + = map rn $ lexExp sourceName lineStart str + where rn (Token strTok sp) + = case renameTok readName strTok of + Just t' -> Token t' sp + Nothing -> Token (KJunk "lexical error") sp + diff --git a/DDC/Core/Eval/Prim.hs b/DDC/Core/Eval/Prim.hs --- a/DDC/Core/Eval/Prim.hs +++ b/DDC/Core/Eval/Prim.hs @@ -14,12 +14,13 @@ import DDC.Core.Eval.Name import DDC.Type.Compounds import DDC.Core.Exp +import DDC.Core.DaCon import qualified DDC.Core.Eval.Store as Store ------------------------------------------------------------------------------- -- | Step a primitive constructor, which allocates an object in the store. stepPrimCon - :: Name -- ^ Name of constructor to allocate. + :: DaCon Name -- ^ Data constructor to evaluate. -> [Exp () Name] -- ^ Arguments to constructor. -> Store -- ^ Current store. -> Maybe ( Store @@ -29,32 +30,41 @@ -- Redirect the unit constructor. -- All unit values point to the same object in the store. -stepPrimCon (NamePrimCon PrimDaConUnit) [] store +stepPrimCon dc xsArgs store + | DaConUnit <- daConName dc + , [] <- xsArgs = Just ( store - , XCon () (UPrim (NameLoc locUnit) tUnit) ) + , xLoc locUnit tUnit ) --- Alloction of Ints. -stepPrimCon (NameInt i) [xR, xUnit] store +stepPrimCon dc xsArgs store + + ------ Alloction of Ints ---------------------------------------- + | Just _ <- takeIntDC dc + , [xR, xUnit'] <- xsArgs + -- unpack the args - | XType tR <- xR + , XType tR <- xR , Just rgn <- takeHandleT tR - , isUnitOrLocX xUnit + , isUnitOrLocX xUnit' -- the store must contain the region we're going to allocate into. , Store.hasRgn store rgn -- add the binding to the store. - , (store1, l) <- Store.allocBind rgn (tInt tR) (SObj (NameInt i) []) store + , (store1, l) <- Store.allocBind rgn + (tInt tR) (SObj dc []) store = Just ( store1 - , XCon () (UPrim (NameLoc l) (tInt tR))) + , xLoc l (tInt tR)) --- Handle Pair specially until we have general data types. -stepPrimCon n@(NamePrimCon PrimDaConPr) [xR, xA, xB, x1, x2] store + ------ Handle Pair specially until we have general data types -- + | Just (NamePrimCon PrimDaConPr) <- takeNameOfDaCon dc + , [xR, xA, xB, x1, x2] <- xsArgs + -- unpack the args - | XType tR <- xR + , XType tR <- xR , Just rgn <- takeHandleT tR , XType tA <- xA , XType tB <- xB @@ -65,33 +75,38 @@ , Store.hasRgn store rgn -- add the binding to the store - , (store1, l) <- Store.allocBind rgn (tPair tR tA tB) (SObj n [l1, l2]) store + , (store1, l) <- Store.allocBind rgn + (tPair tR tA tB) (SObj dc [l1, l2]) store = Just ( store1 - , XCon () (UPrim (NameLoc l) (tPair tR tA tB))) + , xLoc l (tPair tR tA tB)) --- Handle Nil and Cons specially until we have general data types. -stepPrimCon n@(NamePrimCon PrimDaConNil) [xR, xA, xUnit] store + ---- Handle Nil and Cons specially until we have general data types. + | Just (NamePrimCon PrimDaConNil) <- takeNameOfDaCon dc + , [xR, xA, xUnit'] <- xsArgs + -- unpack the args - | XType tR <- xR + , XType tR <- xR , Just rgn <- takeHandleT tR , XType tA <- xA - , isUnitOrLocX xUnit + , isUnitOrLocX xUnit' -- the store must contain the region we're going to allocate into. , Store.hasRgn store rgn -- add the binding to the store - , (store1, l) <- Store.allocBind rgn (tList tR tA) (SObj n []) store - + , (store1, l) <- Store.allocBind rgn + (tList tR tA) (SObj dc []) store = Just ( store1 - , XCon () (UPrim (NameLoc l) (tList tR tA))) + , xLoc l (tList tR tA)) -stepPrimCon n@(NamePrimCon PrimDaConCons) [xR, xA, xHead, xTail] store + | Just (NamePrimCon PrimDaConCons) <- takeNameOfDaCon dc + , [xR, xA, xHead, xTail] <- xsArgs + -- unpack the args - | XType tR <- xR + , XType tR <- xR , Just rgn <- takeHandleT tR , XType tA <- xA , Just lHead <- takeLocX xHead @@ -101,10 +116,11 @@ , Store.hasRgn store rgn -- add the binding to the store - , (store1, l) <- Store.allocBind rgn (tList tR tA) (SObj n [lHead, lTail]) store + , (store1, l) <- Store.allocBind rgn + (tList tR tA) (SObj dc [lHead, lTail]) store = Just ( store1 - , XCon () (UPrim (NameLoc l) (tList tR tA))) + , xLoc l (tList tR tA)) stepPrimCon _ _ _ = Nothing @@ -137,8 +153,11 @@ , Just l2 <- stripLocX xL2 -- get the regions and values of each location - , Just (r1', _, SObj (NameInt i1) []) <- Store.lookupRegionTypeBind l1 store - , Just (r2', _, SObj (NameInt i2) []) <- Store.lookupRegionTypeBind l2 store + , Just (r1', _, SObj dc1 []) <- Store.lookupRegionTypeBind l1 store + , Just i1 <- takeIntDC dc1 + + , Just (r2', _, SObj dc2 []) <- Store.lookupRegionTypeBind l2 store + , Just i2 <- takeIntDC dc2 -- the locations must be in the regions the args said they were in , r1' == r1 @@ -151,10 +170,12 @@ , i3 <- i1 `fOp` i2 -- write the result to a new location in the store - , (store1, l3) <- Store.allocBind r3 (tInt tR3) (SObj (NameInt i3) []) store + , (store1, l3) <- Store.allocBind r3 (tInt tR3) + (SObj (dcInt i3) []) + store = Just ( store1 - , XCon () (UPrim (NameLoc l3) (tInt tR3))) + , xLoc l3 (tInt tR3)) -- Update integer primop. @@ -170,18 +191,20 @@ , r1W == r1 -- get the regions and values of each location - , Just (r1L, tX1, SObj (NameInt _) []) <- Store.lookupRegionTypeBind l1 store - , Just (r2L, _, SObj (NameInt i2) []) <- Store.lookupRegionTypeBind l2 store + , Just (r1L, tX1, SObj dc1 []) <- Store.lookupRegionTypeBind l1 store + , Just _i1 <- takeIntDC dc1 + , Just (r2L, _, SObj dc2 []) <- Store.lookupRegionTypeBind l2 store + , Just i2 <- takeIntDC dc2 + -- the locations must be in the regions the args said they were in , r1L == r1 , r2L == r2 -- update the destination - , store1 <- Store.addBind l1 r1 tX1 (SObj (NameInt i2) []) store - + , store1 <- Store.addBind l1 r1 tX1 (SObj (dcInt i2) []) store = Just ( store1 - , XCon () (UPrim (NamePrimCon PrimDaConUnit) tUnit)) + , xUnit) -- Unary integer operations stepPrimOp (NamePrimOp op) [xR1, xR2, xL1] store @@ -195,7 +218,8 @@ , Just l1 <- stripLocX xL1 -- get the region and value of the int - , Just (r1L, _, SObj (NameInt i1) []) <- Store.lookupRegionTypeBind l1 store + , Just (r1L, _, SObj dc1 []) <- Store.lookupRegionTypeBind l1 store + , Just i1 <- takeIntDC dc1 -- the locations must be in the regions the args said they were in , r1L == r1 @@ -204,13 +228,13 @@ , Store.hasRgn store r2 -- calculate - , i2 <- fOp i1 + , i2 <- fOp i1 -- write the result to a new location in the store - , (store1, l2) <- Store.allocBind r2 (tInt tR2) (SObj (NameInt i2) []) store + , (store1, l2) <- Store.allocBind r2 (tInt tR2) (SObj (dcInt i2) []) store = Just ( store1 - , XCon () (UPrim (NameLoc l2) (tInt tR2))) + , xLoc l2 (tInt tR2)) stepPrimOp _ _ _ = Nothing diff --git a/DDC/Core/Eval/Profile.hs b/DDC/Core/Eval/Profile.hs new file mode 100644 --- /dev/null +++ b/DDC/Core/Eval/Profile.hs @@ -0,0 +1,40 @@ + +-- | Core language profile for the evaluator. +module DDC.Core.Eval.Profile + (evalProfile) +where +import DDC.Core.Fragment +import DDC.Core.Eval.Env +import DDC.Core.Eval.Name + + +-- | Core language fragment that can be directly evaluated. +evalProfile :: Profile Name +evalProfile + = Profile + { profileName = "Eval" + , profileFeatures = evalFeatures + , profilePrimDataDefs = primDataDefs + , profilePrimKinds = primKindEnv + , profilePrimTypes = primTypeEnv + , profileTypeIsUnboxed = const False } + + +-- | Language features used by the eval fragment. +evalFeatures :: Features +evalFeatures + = Features + { featuresUntrackedClosures = False + , featuresUntrackedEffects = False + , featuresPartialPrims = False + , featuresPartialApplication = True + , featuresGeneralApplication = True + , featuresNestedFunctions = True + , featuresLazyBindings = True + , featuresDebruijnBinders = True + , featuresUnboundLevel0Vars = False + , featuresUnboxedInstantiation = True + , featuresNameShadowing = True + , featuresUnusedBindings = True + , featuresUnusedMatches = True } + diff --git a/DDC/Core/Eval/Step.hs b/DDC/Core/Eval/Step.hs --- a/DDC/Core/Eval/Step.hs +++ b/DDC/Core/Eval/Step.hs @@ -7,6 +7,7 @@ , isValue , isWeakValue) where +import DDC.Core.Eval.Profile import DDC.Core.Eval.Store import DDC.Core.Eval.Name import DDC.Core.Eval.Prim @@ -16,10 +17,10 @@ import DDC.Core.Transform.SubstituteXX import DDC.Core.Transform.SubstituteTX import DDC.Core.Check -import DDC.Core.Compounds import DDC.Core.Predicates +import DDC.Core.Compounds import DDC.Core.Exp -import DDC.Type.Compounds +import qualified DDC.Core.Fragment as C import qualified Data.Set as Set @@ -40,7 +41,7 @@ | StepStuck -- | Expression is stuck, and we know for sure it's mistyped. - | StepStuckMistyped (Error () Name) + | StepMistyped (Error () Name) deriving (Show) @@ -56,7 +57,8 @@ force store xx | (casts, xx') <- unwrapCasts xx - , XCon _ (UPrim (NameLoc l) _) <- xx' + , XCon _ dc <- xx' + , Just (NameLoc l) <- takeNameOfDaCon dc , Just (rgn, t, SThunk x) <- lookupRegionTypeBind l store = case force store x of StepProgress store' x' @@ -90,40 +92,37 @@ step store xx | (casts, xp) <- unwrapCasts xx , isLambdaX xp - = case typeOfExp primDataDefs xp of - Left err -> StepStuckMistyped err + = case typeOfExp + (configOfProfile evalProfile) + (C.profilePrimKinds evalProfile) + (C.profilePrimTypes evalProfile) + xp + of Left err -> StepMistyped err Right t - -> let Just (bs, xBody) = takeXLamFlags xp - (store', l) = allocBind (Rgn 0) t (SLams bs xBody) store - in StepProgress store' (wrapCasts casts $ XCon () (UPrim (NameLoc l) t)) + -> let Just (bs, xBody) = takeXLamFlags xp + (store', l) = allocBind (Rgn 0) t (SLams bs xBody) store + x' = xLoc l t + in StepProgress store' (wrapCasts casts x') -- (EvAlloc) -- Construct some data in the heap. step store xx - | Just (u, xs) <- takeXConApps xx - , case u of - -- Unit constructors are not allocated into the store. - UPrim NamePrimCon{} _ -> True - UPrim NameInt{} _ -> True - UPrim NameCon{} _ -> True - _ -> False - - , UPrim n _ <- u - , Just arity <- arityOfName n - , length xs == arity + | Just (dc, xs) <- takeXConApps xx , and $ map (isWeakValue store) xs - , Just (store', x') <- stepPrimCon n xs store + , Just (store', x') <- stepPrimCon dc xs store = StepProgress store' x' -- (EvPrim) -- Step a primitive operator or constructor defined by the client. step store xx - | x1@(XVar _ (UPrim p _)) : xs <- takeXApps xx - , Just arity <- arityOfName p + | Just (x1@(XVar _ (UPrim p _)), xs) <- takeXApps xx + , Just arity <- arityOfName p = let - -- TODO: we're not allowing over-applied primops + -- ISSUE #296: Evaluator doesn't support over-applied primops. + -- This would be a problem if we read a reference to a function + -- and then apply it directly. stepArg i _acc [] | i == arity , Just (store', x') <- stepPrimOp p xs store @@ -136,7 +135,7 @@ stepArg i acc (ax:axs) = case force store ax of StepProgress store' x' - -> Right (store', makeXApps () x1 (reverse acc ++ (x' : axs))) + -> Right (store', xApps () x1 (reverse acc ++ (x' : axs))) StepDone -> case stepArg (i + 1) (ax : acc) axs of @@ -153,8 +152,8 @@ -- (EvAppArgs) -- Step the left-most non-wnf argument of a lambda. step store xx - | x1 : xsArgs <- takeXApps xx - , Just l1 <- takeLocX x1 + | Just (x1, xsArgs) <- takeXApps xx + , Just l1 <- takeLocX x1 , Just (Rgn 0, _, SLams bs _xBody) <- lookupRegionTypeBind l1 store -- See if an arg to any of the lambdas needs to be stepped. @@ -184,15 +183,15 @@ in case stepArg wnfs xsArgs of Left err -> err Right (store2, xsArgs') - -> StepProgress store2 (makeXApps () x1 xsArgs') + -> StepProgress store2 (xApps () x1 xsArgs') -- (EvAppSubst) -- Substitute wnf arguments into an abstraction. step store xx - | x1 : xsArgs <- takeXApps xx - , (casts, xL1) <- unwrapCasts x1 - , Just l1 <- takeLocX xL1 + | Just (x1, xsArgs) <- takeXApps xx + , (casts, xL1) <- unwrapCasts x1 + , Just l1 <- takeLocX xL1 , Just (Rgn 0, _, SLams fbs xBody) <- lookupRegionTypeBind l1 store @@ -215,7 +214,7 @@ $ makeXLamFlags () bsLeftover xBody in StepProgress store - $ wrapCasts casts (makeXApps () xResult argsLeftover) + $ wrapCasts casts (xApps () xResult argsLeftover) -- (EvApp1 / EvApp2) @@ -254,11 +253,15 @@ step store (XLet _ (LLet (LetLazy _w) b x1) x2) -- We need the type of the expression to attach to the location -- This fakes the store typing from the formal typing rules. - = case typeOfExp primDataDefs x1 of - Left err -> StepStuckMistyped err + = case typeOfExp (configOfProfile evalProfile) + (C.profilePrimKinds evalProfile) + (C.profilePrimTypes evalProfile) + x1 + of + Left err -> StepMistyped err Right t1 -> let (store1, l) = allocBind (Rgn 0) t1 (SThunk x1) store - x1' = XCon () (UPrim (NameLoc l) t1) + x1' = xLoc l t1 in StepProgress store1 (substituteXX b x1' x2) @@ -270,12 +273,11 @@ -- Allocate new locations in the store to hold the expressions. (store1, ls) = newLocs (length bs) store - xls = [XCon () (UPrim (NameLoc l) t) | (l, t) <- zip ls ts] + xls = [xLoc l t | (l, t) <- zip ls ts] -- Substitute locations into all the bindings. xs' = map (substituteXXs (zip bs xls)) xs - -- Create store objects for each of the bindings. mos = map (\x -> case takeXLamFlags x of Just (fbs', xBody) -> Just $ SLams fbs' xBody @@ -299,16 +301,18 @@ -- (EvCreateRegion) -- Create a new region. -step store (XLet a (LLetRegion bRegion bws) x) - | Just uRegion <- takeSubstBoundOfBind bRegion +step store (XLet a (LLetRegions bRegions bws) x) + | uRegions <- takeSubstBoundsOfBinds bRegions -- Allocate a new region handle for the bound region. , (store1, uHandle@(UPrim (NameRgn rgn) _)) <- primNewRegion store - , tHandle <- TCon $ TyConBound uHandle + , tHandle <- TCon $ TyConBound uHandle kRegion -- Substitute handle into the witness types. - , bws' <- map (substituteBoundTX uRegion tHandle) bws + , bws' <- concatMap + (\uRegion -> map (substituteBoundTX uRegion tHandle) bws) + uRegions -- Build witnesses for each of the witness types. -- This can fail if the set of witness signatures is malformed. @@ -317,8 +321,11 @@ $ map typeOfBind bws' = let -- Substitute handle and witnesses into body. - x' = substituteBoundTX uRegion tHandle - $ substituteWXs (zip bws' wits) x + substituteBoundTX' xx u + = substituteBoundTX u tHandle xx + + x' = substituteWXs (zip bws' wits) x + x'' = foldl substituteBoundTX' x' uRegions isGlobalBind b = case typeOfBind b of @@ -331,7 +338,7 @@ then setGlobal rgn store1 else store1 - in StepProgress store2 (XLet a (LWithRegion uHandle) x') + in StepProgress store2 (XLet a (LWithRegion uHandle) x'') -- Region binder was a wildcard, so we can't create the region handle. -- No witness sigs can be in the set, because any sig would need @@ -373,7 +380,8 @@ StepDone | (casts, xDiscrim') <- unwrapCasts xDiscrim , Just lDiscrim <- takeLocX xDiscrim' - , Just (SObj nTag lsArgs) <- lookupBind lDiscrim store + , Just (SObj dc lsArgs) <- lookupBind lDiscrim store + , Just nTag <- takeNameOfDaCon dc , Just tsArgs <- sequence $ map (\l -> lookupTypeOfLoc l store) lsArgs , AAlt pat xBody : _ <- filter (tagMatchesAlt nTag) alts -> case pat of @@ -381,7 +389,7 @@ -> StepProgress store xBody PData _ bsArgs - | bxsArgs <- [ (b, wrapCasts casts (XCon a (UPrim (NameLoc l) t))) + | bxsArgs <- [ (b, wrapCasts casts (xLoc l t)) | l <- lsArgs | t <- tsArgs | b <- bsArgs] @@ -407,6 +415,17 @@ = case step store x of StepProgress store' x' -> StepProgress store' (XCast a cc x') + + -- Strip out any weakens, so we can evaluate further. + -- XXX this should probably be elsewhere + StepDone + -> case cc of + CastWeakenEffect _ + -> StepProgress store x + CastWeakenClosure _ + -> StepProgress store x + _ -> StepDone + err -> err @@ -419,7 +438,7 @@ -- Casts ---------------------------------------------------------------------- -- Unwrap casts from the front of an expression. -unwrapCasts :: Exp () n -> ([Cast n], Exp () n) +unwrapCasts :: Exp () n -> ([Cast () n], Exp () n) unwrapCasts xx = case xx of XCast _ c x @@ -430,7 +449,7 @@ -- Wrap casts around an expression. -wrapCasts :: [Cast n] -> Exp () n -> Exp () n +wrapCasts :: [Cast () n] -> Exp () n -> Exp () n wrapCasts cc xx = case cc of [] -> xx @@ -447,8 +466,8 @@ -- | See if a constructor tag matches a pattern. tagMatchesPat :: Name -> Pat Name -> Bool tagMatchesPat _ PDefault = True -tagMatchesPat n (PData u' _) - = case takeNameOfBound u' of +tagMatchesPat n (PData dc _) + = case takeNameOfDaCon dc of Just n' -> n == n' _ -> False @@ -465,6 +484,7 @@ -- These are all the values, and locations that point to thunks. -- -- Weak values can be progressed with `force`, but not `step`. +-- isWeakValue :: Store -> Exp a Name -> Bool isWeakValue store xx = isSomeValue True store xx @@ -477,8 +497,9 @@ = case xx of XVar{} -> True - XCon _ (UPrim (NameLoc l) _) - | Just SThunk{} <- lookupBind l store + XCon _ dc + | Just (NameLoc l) <- takeNameOfDaCon dc + , Just SThunk{} <- lookupBind l store -> weak XCon{} -> True @@ -503,23 +524,23 @@ XApp _ x1 x2 -- Application if a primop to enough args is not wnf. - | Just (n, xs) <- takeXPrimApps xx + | Just (n, xs) <- takeXPrimApps xx , and $ map (isSomeValue weak store) xs - , Just a <- arityOfName n + , Just a <- arityOfName n , length xs >= a -> False -- Application of a lambda in the store is not wnf. - | Just (u, _xs) <- takeXConApps xx - , UPrim (NameLoc l) _ <- u - , Just SLams{} <- lookupBind l store + | Just (dc, _xs) <- takeXConApps xx + , Just (NameLoc l) <- takeNameOfDaCon dc + , Just SLams{} <- lookupBind l store -> False -- Application of a data constructor to enough args is not wnf. - | Just (u, xs) <- takeXConApps xx + | Just (dc, xs) <- takeXConApps xx , and $ map (isSomeValue weak store) xs - , UPrim n _ <- u - , Just a <- arityOfName n + , Just n <- takeNameOfDaCon dc + , Just a <- arityOfName n , length xs >= a -> False @@ -534,11 +555,12 @@ -- permitted in a letregion. regionWitnessOfType :: Type Name -> Maybe (Witness Name) regionWitnessOfType tt - = case tt of - TApp (TCon (TyConWitness TwConGlobal)) r -> Just $ wGlobal r - TApp (TCon (TyConWitness TwConMutable)) r -> Just $ wMutable r - TApp (TCon (TyConWitness TwConConst)) r -> Just $ wConst r - TApp (TCon (TyConWitness TwConLazy)) r -> Just $ wLazy r - TApp (TCon (TyConWitness TwConManifest)) r -> Just $ wManifest r + = case takeTyConApps tt of + Just (TyConWitness TwConGlobal , [r]) -> Just $ wGlobal r + Just (TyConWitness TwConMutable , [r]) -> Just $ wMutable r + Just (TyConWitness TwConConst , [r]) -> Just $ wConst r + Just (TyConWitness TwConLazy , [r]) -> Just $ wLazy r + Just (TyConWitness TwConManifest , [r]) -> Just $ wManifest r + Just (TyConWitness (TwConDistinct n), rs) -> Just $ wDistinct n rs _ -> Nothing diff --git a/DDC/Core/Eval/Store.hs b/DDC/Core/Eval/Store.hs --- a/DDC/Core/Eval/Store.hs +++ b/DDC/Core/Eval/Store.hs @@ -27,8 +27,9 @@ , lookupRegionTypeBind) where import DDC.Core.Exp +import DDC.Core.DaCon import DDC.Core.Eval.Name -import DDC.Core.Eval.Compounds +import DDC.Type.Compounds import Control.Monad import DDC.Core.Pretty hiding (empty) import Data.Map (Map) @@ -64,7 +65,7 @@ data SBind -- | An algebraic data constructor. = SObj - { sbindDataTag :: Name + { sbindDataTag :: DaCon Name , sbindDataArgs :: [Loc] } -- | Lambda abstraction, used for recursive bindings. @@ -132,7 +133,7 @@ , storeBinds = Map.fromList - [ (Loc 0, (Rgn 0, tUnit, SObj (NamePrimCon PrimDaConUnit) []))] + [ (Loc 0, (Rgn 0, tUnit, SObj dcUnit []))] } -- | Location of the static unit object. @@ -143,11 +144,12 @@ -- | Check whether an expression is the unit constructor, -- or its static heap location. isUnitOrLocX :: Exp a Name -> Bool -isUnitOrLocX xx - = case xx of - XCon _ (UPrim (NamePrimCon PrimDaConUnit) _) -> True - XCon _ (UPrim (NameLoc l) _) -> l == locUnit - _ -> False +isUnitOrLocX (XCon _ dc) + = case daConName dc of + DaConUnit -> True + DaConNamed (NameLoc l) -> l == locUnit + _ -> False +isUnitOrLocX _ = False -- Locations ------------------------------------------------------------------ diff --git a/ddc-core-eval.cabal b/ddc-core-eval.cabal --- a/ddc-core-eval.cabal +++ b/ddc-core-eval.cabal @@ -1,5 +1,5 @@ Name: ddc-core-eval -Version: 0.2.1.2 +Version: 0.3.1.1 License: MIT License-file: LICENSE Author: The Disciplined Disciple Compiler Strike Force @@ -10,7 +10,7 @@ Category: Compilers/Interpreters Homepage: http://disciple.ouroborus.net Bug-reports: disciple@ouroborus.net -Synopsis: Disciple Core language semantic evaluator. +Synopsis: Disciplined Disciple Compiler semantic evaluator for the core language. Description: This is a direct implementation of the operational semantics and is by no means fast, or a substitute for a real interpreter. Programs run with this @@ -21,12 +21,13 @@ Library Build-Depends: base == 4.6.*, + deepseq == 1.3.*, containers == 0.5.*, array == 0.4.*, transformers == 0.3.*, mtl == 2.1.*, - ddc-base == 0.2.1.*, - ddc-core == 0.2.1.* + ddc-base == 0.3.1.*, + ddc-core == 0.3.1.* Exposed-modules: DDC.Core.Eval.Check @@ -34,6 +35,7 @@ DDC.Core.Eval.Env DDC.Core.Eval.Name DDC.Core.Eval.Prim + DDC.Core.Eval.Profile DDC.Core.Eval.Step DDC.Core.Eval.Store DDC.Core.Eval @@ -57,4 +59,4 @@ ScopedTypeVariables StandaloneDeriving DoAndIfThenElse - + DeriveDataTypeable