CSPM-Interpreter 0.3.0.0 → 0.4.0.2

raw patch · 3 files changed

+34/−37 lines, 3 filesdep ~CSPM-FrontendPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: CSPM-Frontend

API changes (from Hackage documentation)

Files

• CSPM-Interpreter.cabal +2/−2
• src/CSPM/Interpreter/Eval.hs +30/−33
• src/CSPM/Interpreter/PatternMatcher.hs +2/−2

@@ -1,5 +1,5 @@ Name:                CSPM-Interpreter-Version:             0.3.0.0+Version:             0.4.0.2  Synopsis:            An interpreter for CSPM Description:@@ -21,7 +21,7 @@ Extra-source-files: Library   Build-Depends:-    CSPM-Frontend >= 0.3.0.0+    CSPM-Frontend >= 0.4 && < 0.5     ,CSPM-CoreLanguage >= 0.1 && < 0.2     ,base >= 4.0 && < 5.0     ,containers >= 0.3 && < 0.4

@@ -41,8 +41,8 @@ import Data.Digest.Pure.HashMD5 as HashClass  import Control.Arrow-import qualified Control.Monad.Reader as Reader-import Control.Monad.RWS.Lazy as RWS hiding (guard)+import Control.Monad.Reader as Reader+import Control.Monad.State.Strict import Control.Monad hiding (guard) import Data.Ord import Data.List as List@@ -50,6 +50,7 @@ import Data.Set (Set) import qualified Data.Map as Map import qualified Data.IntMap as IntMap+import Data.IntMap (IntMap) import qualified Data.List as List import Debug.Trace @@ -71,31 +72,15 @@ eval expr = case unLabel expr of   Var v -> lookupIdent v   IntExp i -> return $ VInt i-  SetEnum s -> do-    l <- mapM eval s-    return $ VSet $ Set.fromList l-  ListEnum l -> mapM eval l >>= return . VList-  SetOpen _  -> throwFeatureNotImplemented "open sets" $ Just $ srcLoc expr-  ListOpen s -> do-  -- todo : this can easily give non-termination-  -- maybe use an enumerator here ?-    x <- evalInt s-    return $ VList $ map VInt [x..]-  SetClose (a,b) -> do-    s <- evalInt a-    e <- evalInt b-    return $ VSet $ Set.fromList $ map VInt [s..e]-  ListClose (a,b) -> do-    s <- evalInt a-    e <- evalInt b-    return $ VList $ map VInt [s..e]-  SetComprehension (el,comps) -> do-    l <- evalSetComp ret comps +  SetExp (unLabel -> RangeOpen _ ) _+    -> throwFeatureNotImplemented "open sets" $ Just $ srcLoc expr+  SetExp r Nothing -> evalRange r >>= return . VSet . Set.fromList+  SetExp r (Just comps) -> do+    l <- evalSetComp ret comps     return $ VSet l-    where ret = mapM eval el >>= return . Set.fromList-  ListComprehension (el, comps) -> do-    l <- evalListComp (mapM eval el) comps-    return $ VList l+    where ret = evalRange r >>= return . Set.fromList+  ListExp r Nothing -> liftM VList $ evalRange r+  ListExp r (Just comps) -> liftM VList $ evalListComp (evalRange r) comps   ClosureComprehension (el, comps) -> do     l <- evalListComp (mapM eval el) comps     ClosureSet.mkEventClosure l >>= return . VClosure@@ -217,6 +202,17 @@   _ -> throwFeatureNotImplemented "hit catch-all case of eval function"          $ Just $ srcLoc expr  +evalRange :: LRange -> EM [Value]+evalRange r = case unLabel r of+  RangeEnum l -> mapM eval l+  RangeClosed start end -> do+    s <- evalInt start+    e <- evalInt end+    return $ map VInt [s..e]+  RangeOpen start -> do+    s <- evalInt start+    return $ map VInt [s..]+   evalBool :: LExp -> EM Bool evalBool e = do   v <- eval e@@ -419,16 +415,17 @@       y <- switchedOffProc b       return $ VProcess $ o x y -type DeclM x = RWS (Digest,Env) () (Bindings, IntMap.IntMap Digest) x- +type DeclM x = ReaderT (Digest,Env) (State (Bindings, IntMap Digest)) x+ processDeclList :: Digest -> Env -> [LDecl] -> Env processDeclList digest oldEnv decls =--- todo :: really do a lot of testing that we do not end in a loop here   let-    ((),(newBinds,newDigests),()) = runRWS action (digest,newEnv) -       (getLetBindings oldEnv, letDigests oldEnv)-    action = mapM_ processDecl decls-    newEnv = oldEnv { letBindings = newBinds, letDigests = newDigests}+    (newBinds,newDigests)+       = execState action' (getLetBindings oldEnv, letDigests oldEnv)+    action :: DeclM ()+    action  = mapM_ processDecl decls+    action' = runReaderT action (digest,newEnv)+    newEnv  = oldEnv { letBindings = newBinds, letDigests = newDigests}   in newEnv  bindIdentM :: LIdent -> Value -> DeclM ()

@@ -64,8 +64,8 @@ match v             (ConstrSel c) = typeError ("expecting constructor " ++ show c) v --  | DotSel Int Int Selector -match (VSet _)      (SingleSetSel _)-  = throwFeatureNotImplemented "single set pattern" Nothing+match (VSet s)      (SingleSetSel b)+  = if not $ Set.null s then match (Set.findMin s) b else failedMatch match v             (SingleSetSel _) = typeError "expecting a set" v  match (VSet s)      EmptySetSel