CSPM-Interpreter 0.5.1.0 → 0.6.0.3

raw patch · 9 files changed

+85/−31 lines, 9 filesdep +prettyclassdep ~CSPM-Frontenddep ~arraydep ~mtlPVP ok

version bump matches the API change (PVP)

Dependencies added: prettyclass

Dependency ranges changed: CSPM-Frontend, array, mtl

API changes (from Hackage documentation)

Files

• CSPM-Interpreter.cabal +10/−7
• src/CSPM/Interpreter.hs +1/−0
• src/CSPM/Interpreter/ClosureSet.hs +4/−4
• src/CSPM/Interpreter/Eval.hs +15/−16
• src/CSPM/Interpreter/Hash.hs +1/−1
• src/CSPM/Interpreter/PatternCompiler.hs +1/−0
• src/CSPM/Interpreter/Pretty.hs +48/−0
• src/CSPM/Interpreter/Test/CLI.hs +4/−2
• src/CSPM/Interpreter/Types.hs +1/−1

@@ -1,5 +1,5 @@ Name:                CSPM-Interpreter-Version:             0.5.1.0+Version:             0.6.0.3  Synopsis:            An interpreter for CSPM Description:@@ -13,26 +13,28 @@ License:             BSD3 category:            Language,Formal Methods,Concurrency License-File:        LICENSE-Author:              2010 - 2011 Marc Fontaine+Author:              2010 - 2012 Marc Fontaine Maintainer:          Marc Fontaine <fontaine@cs.uni-duesseldorf.de> Stability:           experimental-Tested-With:         GHC == 7.0.3+Tested-With:         GHC == 7.4.1  cabal-Version:       >= 1.10 build-type: Simple Extra-source-files: Library   Build-Depends:-    CSPM-Frontend >= 0.7 && < 0.8+    CSPM-Frontend >= 0.9 && < 0.10     ,CSPM-CoreLanguage >= 0.3 && < 0.4+    ,prettyclass >= 1.0 && < 1.1     ,base >= 4.0 && < 5.0     ,containers >= 0.4 && < 0.5-    ,mtl (>= 2.0 && < 2.1 ) || (>= 1.1 && < 1.2)-    ,array >= 0.3 && <0.4+    ,mtl+    ,array >= 0.4 && <0.5     ,syb >= 0.3 && < 0.4 +   Default-Language: Haskell2010-  GHC-Options: -funbox-strict-fields -O2 -Wall+  GHC-Options: -funbox-strict-fields -O2 -Wall  -fsimpl-tick-factor=400   Other-Extensions: DeriveDataTypeable, GeneralizedNewtypeDeriving   Hs-Source-Dirs:       src   Exposed-modules:@@ -43,6 +45,7 @@     CSPM.Interpreter.Hash     CSPM.Interpreter.ClosureSet     CSPM.Interpreter.Test.CLI+    CSPM.Interpreter.Pretty   Other-modules:     CSPM.Interpreter.Renaming     CSPM.Interpreter.PrepareAST

@@ -33,6 +33,7 @@ import CSPM.Interpreter.Eval import CSPM.Interpreter.PrepareAST import CSPM.Interpreter.Test.CLI+import CSPM.Interpreter.Pretty ()  import Language.CSPM.AST as AST 

@@ -114,8 +114,8 @@       PTAny {} -> throwFeatureNotImplemented "cannot enumerate PTAny (Set,Seq,INT)"                     Nothing Nothing       PTMap m -> foldl' (add path) acc $ Map.assocs m-      PTRec s t -> foldl' (add path) acc $ zip (Set.elems s) $ repeat t-      PTSingle v t -> worker acc (v:path) t+      PTRec s r -> foldl' (add path) acc $ zip (Set.elems s) $ repeat r+      PTSingle v r -> worker acc (v:path) r       PTClosure l -> worker acc path l     add :: [Value] -> [Value] -> (Value,PrefixTrie) -> [Value]     add path acc (val,t) = worker acc (val:path) t@@ -132,8 +132,8 @@ valueToPT v = case v of   VChannel c -> fieldsToPT [v] $ (SSet.Total : chanFields c)   VDotTuple [] -> throwScriptError "valueToPT : empty dot-tuple" Nothing Nothing-  VDotTuple l@(VChannel c : t) -> fieldsToPT l (SSet.Total : chanFields c)-  VDotTuple l -> throwScriptError "valueToPT : dot-tuple does not start with a channel"+  VDotTuple l@(VChannel c : _) -> fieldsToPT l (SSet.Total : chanFields c)+  VDotTuple _ -> throwScriptError "valueToPT : dot-tuple does not start with a channel"         Nothing $ Just v   _ -> throwScriptError "valueToPT: cannot make a event-closure of value"          Nothing $ Just v

@@ -61,8 +61,6 @@ runEnv :: Env -> EM x -> x runEnv env action = Reader.runReader (unEM action) env -{- todo : check whether the order of the cases influences efficency. -}- -- | Evaluate an expression in the 'EM' monad. eval :: LExp -> EM Value eval expr = case unLabel expr of@@ -113,10 +111,10 @@   CFalse -> return $ VBool False   BoolSet -> return $ VSet $ Set.fromList [VBool True,VBool False] {--  many prob test contain unboundet INT+  Many prob test contain unboundet INT   IntSet -> return $ VAllInts -}-  IntSet -> return $ VSet $ Set.fromList $ map VInt [0..100] --ToDo: fix this !!+  IntSet -> return $ VSet $ Set.fromList $ map VInt [0..100] --ToDo: Fix this !!   TupleExp l -> mapM eval l >>= return . VTuple   Parens e -> eval e   AndExp a b -> do@@ -408,7 +406,7 @@       y <- switchedOffProc b       return $ VProcess $ o x y --- | A process a module and return the top-level envirionment+-- | Process a module and return the top-level envirionment. evalModule :: Module INT -> Env evalModule m   = processDeclList (hs "TopLevelEnvirionment") emptyEnvirionment@@ -518,8 +516,8 @@     VInt {} -> return $ SSet.singleton v     VChannel {} -> return $ SSet.singleton v     VSet s -> return $ SSet.Proper s--- todo : fixthis when we have ClosureExpressions--- todo: this does not work for constructors that have fields+-- todo: Fix this when we have ClosureExpressions.+-- todo: This does not work for constructors that have fields.     VDataType constrList -> return $ SSet.fromList $ map VConstructor constrList     VNameType _ -> throwInternalError "nametype not implemented" (Just $ srcLoc expr) $ Just v     VAllInts -> return $ SSet.fromList $ map VInt [0..10] --todo@@ -544,11 +542,11 @@     VChannel {} -> return v     VConstructor {} -> return v     VTuple {} -> return v -    VDotTuple {} -> return v -- todo : fix for genric buffers+    VDotTuple {} -> return v -- todo : Fix for genric buffers     VBool {} -> return v {--todo: support lists and sets as channel fields-write test for VSet and VList+todo: Dupport lists and sets as channel fields.+Write test for VSet and VList. -}     VSet {} -> return v     VList {} -> return v        @@ -556,7 +554,7 @@     _ -> throwTypingError "Eval.hs : evalOutField" (Just $ srcLoc expr) $ Just v  -{- redo this: most procComprehensions work on sets ! -}+{- redo this: Most procComprehensions work on sets ! -} evalProcCompL :: LExp -> LCompGenList -> EM [Process] evalProcCompL p comp = evalListComp ret $ unLabel comp   where@@ -565,7 +563,7 @@       return [r]  {--fdr does not remove duplicates from replicatesProc compostions +fdr does not remove duplicates from replicatesProc compostions, see examples/CSP/FDRFeatureTests/ReplicatedInterleaveSetDef.csp -} evalProcCompS :: LExp -> LCompGenList -> EM [Process]@@ -575,8 +573,9 @@   =     (evalSetComp ret $ unLabel comp)     >>= (mapM processFromValue) . Set.toList   where-{- we intermediatley wrap processes with VProcess -if we make evalSetComp polymorphic we get the following error+{-+We intermediateley wrap processes with VProcess.+If we make evalSetComp polymorphic we get the following error src/Language/CSPM/Interpreter/Eval.hs:536:0:     Contexts differ in length       (Use -XRelaxedPolyRec to allow this)@@ -684,10 +683,10 @@          env (zip patList valList)  {--  going from+  Going from   callFkt fkt args = return $ tryFunCases (getFunCases fkt) args (getFunEnv fkt)   to the version which supports partial application-  costs ca 17 % in the fibonacci -example+  costs approx. 17 % in the fibonacci -example. -}     callFkt :: FunClosure -> [Value] -> EM Value     callFkt fkt args

@@ -11,7 +11,7 @@ -- Instances of the Hash class for interpreter types and core language types -- -----------------------------------------------------------------------------{-# LANGUAGE TypeSynonymInstances,FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances,FlexibleInstances, BangPatterns #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  module CSPM.Interpreter.Hash

@@ -141,6 +141,7 @@         l <- mapM lengthOfListPattern patl         return $ sum l       VarPat _ -> Nothing+      WildCard -> Nothing       Also patl -> do         let l = map lengthOfListPattern patl         -- todo: check that all length are equal:

@@ -0,0 +1,48 @@+----------------------------------------------------------------------------+-- |+-- Module      :  CSPM.Interpreter.Pretty+-- Copyright   :  (c) Fontaine 2011+-- License     :  BSD3+--+-- Maintainer  :  Fontaine@cs.uni-duesseldorf.de+-- Stability   :  experimental+-- Portability :  GHC-only+--+-- A pretty-printer for values.+--+----------------------------------------------------------------------------+module CSPM.Interpreter.Pretty+where++import CSPM.Interpreter.Types+import CSPM.Interpreter.ClosureSet (closureToSet)++import Text.PrettyPrint.HughesPJClass+import qualified Data.Set as Set++instance Pretty Value where+  pPrint v = case v of+    VInt  i -> pPrint i+    VBool True -> text "true"+    VBool False -> text "false"+    VList l -> text "<" <> commaList l <> text ">"+    VTuple l -> parens $ commaList l+    VDotTuple l -> parens $ hcat $ punctuate (text ".") $ map pPrint l+    VSet s -> text "{" <> (commaList $ Set.toList s) <> text "}"+    VClosure s -> text "{|" <> (commaList $ Set.toList $ closureToSet s) <> text "|}"+    VProcess _ -> unPrintable "a process"+    VChannel c -> text $ chanName c+    VFun _ -> unPrintable "a function closure"+    VUnit -> text "()"+    VAllInts -> unPrintable "set of all Integer"+    VAllSequences _  -> unPrintable "VAllSequences"+    VConstructor c -> text $ constrName c+    VDataType _ -> text "datatype"+    VNameType _ -> text "nametype"+    VPartialApplied {} -> unPrintable "partially applyed function"+    _ -> unPrintable $ show v+    where+      commaList :: [Value] -> Doc+      commaList = hcat . punctuate comma . map pPrint+      unPrintable :: String -> Doc+      unPrintable s = parens $ text "{-" <> text s <> text "-}"

@@ -42,7 +42,9 @@ import CSPM.Interpreter.Types (Value) import CSPM.Interpreter.PrepareAST (prepareAST) import CSPM.Interpreter.CoreInstances ()+import CSPM.Interpreter.Pretty () +import Text.PrettyPrint.HughesPJClass import System.Exit import System.CPUTime import Control.Exception.Base (evaluate)@@ -63,7 +65,7 @@         $ handleRenameError renameErrorHandler $   do     res <- evalFile False (Just fileName) expr-    putStrLn $ show $ fst res+    putStrLn $ prettyShow $ fst res     exitSuccess  {- Todo: clean up the mess below -}@@ -120,7 +122,7 @@     val :: Value     val = (IntMap.!) (Types.getLetBindings env) $ AST.uniqueIdentId entry   when verbose $ do-     putStrLn $ "eval result         : " ++ show val+     putStrLn $ "eval result         : " ++ prettyShow val      time_finish_execute <- getCPUTime      putStrLn $ "eval execution time : " ++ showTime (time_finish_execute - time_start_execute)   return (val,env)

@@ -18,7 +18,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE DeriveDataTypeable #-}-+{-# LANGUAGE FlexibleInstances #-} module CSPM.Interpreter.Types where