ddc-core-eval 0.2.0.1 → 0.2.1.1

raw patch · 8 files changed

+188/−47 lines, 8 filesdep ~ddc-basedep ~ddc-corePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: ddc-base, ddc-core

API changes (from Hackage documentation)

Files

• DDC/Core/Eval/Compounds.hs +14/−6
• DDC/Core/Eval/Env.hs +51/−20
• DDC/Core/Eval/Name.hs +17/−5
• DDC/Core/Eval/Prim.hs +59/−2
• DDC/Core/Eval/Step.hs +0/−1
• DDC/Core/Eval/Store.hs +31/−7
• LICENSE +11/−1
• ddc-core-eval.cabal +5/−5

@@ -5,6 +5,7 @@         ( -- * Types           tUnit         , tInt+        , tPair         , tList             -- * Witnesses@@ -29,18 +30,26 @@   -- Type -------------------------------------------------------------------------- | Application of the Unit data type constructor.+-- | Application of the Unit type constructor. tUnit :: Type Name tUnit   = TCon (TyConBound (UPrim (NamePrimCon PrimTyConUnit) kData))  --- | Application of the Int data type constructor.+-- | 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 List data type constructor.+-- | 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]+++-- | Application of the List type constructor. tList :: Region Name -> Type Name -> Type Name tList tR tA         = tApps (TCon  (TyConBound (UPrim (NamePrimCon PrimTyConList)@@ -101,9 +110,8 @@ isUnitX :: Exp a Name -> Bool isUnitX xx  = case xx of-        XCon _   (UPrim (NamePrimCon PrimDaConUnit) _)  -                -> True-        _       -> False+        XCon _   (UPrim (NamePrimCon PrimDaConUnit) _)  -> True+        _                                               -> False   -- | Take a region handle from a type.

@@ -50,6 +50,13 @@                 [kRegion]                 Nothing +        -- Pair+        , DataDef+                (NamePrimCon PrimTyConPair)+                [kRegion, kData, kData]+                (Just   [ ( NamePrimCon PrimDaConPr+                          , [tIx kData 1, tIx kData 0]) ])+         -- List         , DataDef                 (NamePrimCon PrimTyConList)@@ -78,14 +85,19 @@         -- Unit         NamePrimCon PrimTyConUnit          -> Just $ kData++        -- Int+        NamePrimCon PrimTyConInt+         -> Just $ kFun kRegion kData++        -- Pair+        NamePrimCon PrimTyConPair+         -> Just $ kRegion `kFun` kData `kFun` kData `kFun` kData                  -- List         NamePrimCon PrimTyConList          -> Just $ kRegion `kFun` kData `kFun` kData -         -- Int-        NamePrimCon PrimTyConInt-         -> Just $ kFun kRegion kData          _ -> Nothing @@ -117,6 +129,14 @@         NamePrimCon PrimDaConUnit          -> Just $ tUnit  +        -- Pair+        NamePrimCon PrimDaConPr+         -> Just $ tForalls [kRegion, kData, kData] $ \[tR, tA, tB]+                 -> tFun tA             (tBot kEffect)+                                        (tBot kClosure)+                 $  tFun tB             (tSum kEffect  [tAlloc   tR])+                                        (tSum kClosure [tDeepUse tA])+                 $  tPair tR tA tB                  -- List         NamePrimCon PrimDaConNil        @@ -127,46 +147,53 @@          NamePrimCon PrimDaConCons          -> Just $ tForalls [kRegion, kData] $ \[tR, tA] -                -> tFun tA            (tBot kEffect)-                                      (tBot kClosure)-                 $ tFun (tList tR tA) (tSum kEffect  [tAlloc   tR])-                                      (tSum kClosure [tDeepUse tA])+                -> tFun tA              (tBot kEffect)+                                        (tBot kClosure)+                 $ tFun (tList tR tA)   (tSum kEffect  [tAlloc   tR])+                                        (tSum kClosure [tDeepUse tA])                  $ tList tR tA          -- Int         NameInt _          -> Just $ tForall kRegion-          $ \r  -> tFun tUnit (tAlloc r)-                              (tBot kClosure)+          $ \r  -> tFun tUnit           (tAlloc r)+                                        (tBot kClosure)                  $ tInt r          -- negInt         NamePrimOp PrimOpNegInt          -> Just $ tForalls [kRegion, kRegion] $ \[r1, r0]-                -> tFun (tInt r1) (tSum kEffect  [tRead r1, tAlloc r0])-                                  (tBot kClosure)+                -> tFun (tInt r1)       (tSum kEffect  [tRead r1, tAlloc r0])+                                        (tBot kClosure)                       $ (tInt r0)          -- add, sub, mul, div, eq         NamePrimOp p          | elem p [PrimOpAddInt, PrimOpSubInt, PrimOpMulInt, PrimOpDivInt, PrimOpEqInt]          -> Just $ tForalls [kRegion, kRegion, kRegion] $ \[r2, r1, r0] -                -> tFun (tInt r2) (tBot kEffect)-                                  (tBot kClosure)-                 $ tFun (tInt r1) (tSum kEffect  [tRead r2, tRead r1, tAlloc r0])-                                  (tSum kClosure [tUse r2])+                -> tFun (tInt r2)       (tBot kEffect)+                                        (tBot kClosure)+                 $ tFun (tInt r1)       (tSum kEffect  [tRead r2, tRead r1, tAlloc r0])+                                        (tSum kClosure [tUse r2])                  $ tInt r0          -- update :: [r1 r2 : %]. Mutable r1 => Int r1 -> Int r2 -(Write r1 + Read r2 | Share r1)> ()         NamePrimOp PrimOpUpdateInt          -> Just $ tForalls [kRegion, kRegion] $ \[r1, r2]                 -> tImpl (tMutable r1)-                $  tFun  (tInt r1) (tBot kEffect)-                                   (tBot kClosure)-                $  tFun  (tInt r2) (tSum kEffect  [tWrite r1, tRead r2])-                                   (tSum kClosure [tUse r1])+                $  tFun  (tInt r1)      (tBot kEffect)+                                        (tBot kClosure)+                $  tFun  (tInt r2)      (tSum kEffect  [tWrite r1, tRead r2])+                                        (tSum kClosure [tUse r1])                 $  tUnit +        -- copy :: [r1 r0 : %]. Int r1 -(Read r1 + Alloc r0 | $0)> Int r0+        NamePrimOp PrimOpCopyInt+         -> Just $ tForalls [kRegion, kRegion] $ \[r1, r0]+                -> tFun (tInt r1)       (tSum kEffect  [tRead r1, tAlloc r0])+                                        (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@@ -188,14 +215,18 @@         NameInt{}                       -> Just 2          NamePrimCon PrimDaConUnit       -> Just 0        +        NamePrimCon PrimDaConPr         -> Just 5         NamePrimCon PrimDaConNil        -> Just 3-         NamePrimCon PrimDaConCons       -> Just 4          NamePrimOp p          | elem p [ PrimOpAddInt, PrimOpSubInt, PrimOpMulInt, PrimOpDivInt                   , PrimOpEqInt]          -> Just 5++        NamePrimOp p+         | elem p [ PrimOpCopyInt, PrimOpNegInt ]+         -> Just 3                   NamePrimOp PrimOpUpdateInt          -> Just 5        

@@ -124,24 +124,29 @@ -- PrimCons ------------------------------------------------------------------- -- | A primitive constructor. data PrimCon+        -- Type constructors         = PrimTyConUnit         -- ^ Unit type constructor (@Unit@).-        | PrimDaConUnit         -- ^ Unit data constructor (@()@).         | PrimTyConInt          -- ^ @Int@  type constructor.+        | PrimTyConPair         -- ^ @Pair@ type constructor.+        | PrimTyConList         -- ^ @List@ type constructor.          -- Implement lists as primitives until we have data decls working-        | PrimTyConList         -- ^ @List@ data type constructor.+        | PrimDaConUnit         -- ^ Unit data constructor (@()@).+        | PrimDaConPr           -- ^ @P@ data construct (pairs).         | PrimDaConNil          -- ^ @Nil@ data constructor.         | PrimDaConCons         -- ^ @Cons@ data constructor.         deriving (Show, Eq, Ord) - instance Pretty PrimCon where  ppr con   = case con of         PrimTyConUnit   -> text "Unit"-        PrimDaConUnit   -> text "()"         PrimTyConInt    -> text "Int"+        PrimTyConPair   -> text "Pair"         PrimTyConList   -> text "List"++        PrimDaConUnit   -> text "()"+        PrimDaConPr     -> text "Pr"         PrimDaConNil    -> text "Nil"         PrimDaConCons   -> text "Cons" @@ -156,6 +161,7 @@         | PrimOpDivInt         | PrimOpEqInt         | PrimOpUpdateInt+        | PrimOpCopyInt         deriving (Show, Eq, Ord)  @@ -169,6 +175,7 @@         PrimOpDivInt    -> text "divInt"         PrimOpEqInt     -> text "eqInt"         PrimOpUpdateInt -> text "updateInt"+        PrimOpCopyInt	-> text "copyInt"   -- Parsing --------------------------------------------------------------------@@ -186,6 +193,7 @@                 "divInt"        -> Just $ NamePrimOp PrimOpDivInt                 "eqInt"         -> Just $ NamePrimOp PrimOpEqInt                 "updateInt"     -> Just $ NamePrimOp PrimOpUpdateInt+                "copyInt"	-> Just $ NamePrimOp PrimOpCopyInt                 _               -> Just $ NameVar str          -- units@@ -197,8 +205,12 @@          | (ds, "")              <- span isDigit str         = Just $ NameInt (read ds)        ++        -- pairs+        | str == "Pair"         = Just $ NamePrimCon PrimTyConPair+        | str == "Pr"           = Just $ NamePrimCon PrimDaConPr         -        -- implement lists as primitive until we have data type decls implemented+        -- lists          | str == "List"         = Just $ NamePrimCon PrimTyConList         | str == "Nil"          = Just $ NamePrimCon PrimDaConNil         | str == "Cons"         = Just $ NamePrimCon PrimDaConCons

@@ -26,12 +26,20 @@                  , Exp () Name) -- ^ New store and result expression,                                  --   if the operator steps, otherwise `Nothing`. ++-- Redirect the unit constructor.+-- All unit values point to the same object in the store.+stepPrimCon (NamePrimCon PrimDaConUnit) [] store+        = Just  ( store+                , XCon () (UPrim (NameLoc locUnit) tUnit) )++ -- Alloction of Ints. stepPrimCon (NameInt i) [xR, xUnit] store         -- unpack the args         | XType tR      <- xR         , Just rgn      <- takeHandleT tR-        , isUnitX xUnit+        , isUnitOrLocX xUnit          -- the store must contain the region we're going to allocate into.         , Store.hasRgn store rgn@@ -43,13 +51,33 @@                 , XCon () (UPrim (NameLoc l) (tInt tR)))  +-- Handle Pair specially until we have general data types.+stepPrimCon n@(NamePrimCon PrimDaConPr) [xR, xA, xB, x1, x2] store+        -- unpack the args+        | XType tR      <- xR+        , Just rgn      <- takeHandleT tR+        , XType tA      <- xA+        , XType tB      <- xB+        , Just l1       <- takeLocX x1+        , Just l2       <- takeLocX x2++        -- 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 (tPair tR tA tB) (SObj n [l1, l2]) store++        = Just  ( store1+                , XCon () (UPrim (NameLoc l) (tPair tR tA tB)))++ -- Handle Nil and Cons specially until we have general data types. stepPrimCon n@(NamePrimCon PrimDaConNil) [xR, xA, xUnit] store         -- unpack the args         | XType tR      <- xR         , Just rgn      <- takeHandleT tR         , XType tA      <- xA-        , isUnitX xUnit+        , isUnitOrLocX xUnit          -- the store must contain the region we're going to allocate into.         , Store.hasRgn store rgn@@ -154,6 +182,35 @@          = Just  ( store1                 , XCon () (UPrim (NamePrimCon PrimDaConUnit) tUnit))++-- Unary integer operations+stepPrimOp (NamePrimOp op) [xR1, xR2, xL1] store+        -- unpack the args+        | Just fOp      <- lookup op+                                [ (PrimOpCopyInt, id)+                                , (PrimOpNegInt,  negate) ]+        , Just r1       <- takeHandleX  xR1+        , XType tR2     <- xR2+        , Just r2       <- takeHandleX  xR2+        , Just l1       <- stripLocX    xL1++        -- get the region and value of the int+        , Just (r1L, _, SObj (NameInt i1)  []) <- Store.lookupRegionTypeBind l1 store++        -- the locations must be in the regions the args said they were in+        , r1L == r1++        -- the destination region must exist+        , Store.hasRgn store r2++	-- calculate+	, i2 <- fOp i1++        -- write the result to a new location in the store+        , (store1, l2)  <- Store.allocBind r2 (tInt tR2) (SObj (NameInt i2) []) store++        = Just  ( store1+                , XCon () (UPrim (NameLoc l2) (tInt tR2)))  stepPrimOp _ _ _         = Nothing

@@ -104,7 +104,6 @@         | Just (u, xs)  <- takeXConApps xx         , case u of             -- Unit constructors are not allocated into the store.-            UPrim (NamePrimCon PrimDaConUnit) _ -> False             UPrim NamePrimCon{} _               -> True             UPrim NameInt{}     _               -> True             UPrim NameCon{}     _               -> True

@@ -13,7 +13,8 @@         , SBind  (..)                  -- * Operators-        , empty+        , initial+        , locUnit,      isUnitOrLocX         , newLoc,       newLocs         , newRgn,       newRgns         , delRgn@@ -27,6 +28,7 @@ where import DDC.Core.Exp import DDC.Core.Eval.Name+import DDC.Core.Eval.Compounds import Control.Monad import DDC.Core.Pretty          hiding (empty) import Data.Map                 (Map)@@ -116,14 +118,36 @@    -- Constructors ------------------------------------------------------------------ | An empty store, with no bindings or regions.-empty   :: Store-empty   = Store+-- | Initial store containing the preallocated regions and bindings.+initial :: Store+initial = Store         { storeNextLoc  = 1         , storeNextRgn  = 1-        , storeRegions  = Set.empty-        , storeGlobal   = Set.empty-        , storeBinds    = Map.empty }++        , storeRegions  +           = Set.fromList [Rgn 0]++        , storeGlobal   +           = Set.fromList [Rgn 0]++        , storeBinds    +           = Map.fromList +                [ (Loc 0, (Rgn 0, tUnit, SObj (NamePrimCon PrimDaConUnit) []))]+        }++-- | Location of the static unit object.+locUnit :: Loc+locUnit = Loc 0+++-- | 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   -- Locations ------------------------------------------------------------------

@@ -1,7 +1,8 @@ -------------------------------------------------------------------------------- The Disciplined Disciple Compiler License (MIT style) -Copyright (c) 2008-2011 Benjamin Lippmeier+Copyrite (K) 2007-2012 The Disciplined Disciple Compiler Strike Force+All rights reversed.  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal@@ -12,6 +13,15 @@  The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.++-------------------------------------------------------------------------------+Under Australian law copyright is free and automatic.+By contributing to DDC authors grant all rights they have regarding their+contributions to the other members of the Disciplined Disciple Compiler Strike+Force, past, present and future, as well as placing their contributions under+the above license.++Use "darcs show authors" to get a list of Strike Force members.  -------------------------------------------------------------------------------- Redistributions of libraries in ./external are governed by their own licenses:

@@ -1,9 +1,9 @@ Name:           ddc-core-eval-Version:        0.2.0.1+Version:        0.2.1.1 License:        MIT License-file:   LICENSE-Author:         Ben Lippmeier-Maintainer:     benl@ouroborus.net+Author:         The Disciplined Disciple Compiler Strike Force+Maintainer:     Ben Lippmeier <benl@ouroborus.net> Build-Type:     Simple Cabal-Version:  >=1.6 Stability:      experimental@@ -25,8 +25,8 @@         array           == 0.4.*,         transformers    == 0.2.*,         mtl             == 2.0.*,-        ddc-base        == 0.2.0.*,-        ddc-core        == 0.2.0.*+        ddc-base        == 0.2.1.*,+        ddc-core        == 0.2.1.*    Exposed-modules:         DDC.Core.Eval.Check