diff --git a/funcons-tools.cabal b/funcons-tools.cabal --- a/funcons-tools.cabal +++ b/funcons-tools.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: funcons-tools -version: 0.2.0.15 +version: 0.2.0.16 synopsis: A modular interpreter for executing funcons description: The PLanCompS project () has developed a component-based approach to formal semantics. @@ -33,6 +33,10 @@ -- extra-source-files: cabal-version: >=1.10 +source-repository head + type: git + location: https://github.com/plancomps/funcons-tools + library exposed-modules: Funcons.EDSL , Funcons.Tools @@ -43,20 +47,20 @@ , Funcons.Parser , Funcons.GLLParser , Funcons.RunOptions - build-depends: base >=4.8 && <= 5 - ,text >= 1.2 + build-depends: base >=4.8 && < 6 + ,text >= 2.1 && <3 ,containers >= 0.5 && < 0.7 - ,vector>=0.12 - ,bv >= 0.5 - ,multiset >= 0.3 - ,split - ,directory - ,mtl >= 2.2.1 - ,gll >= 0.4.0.9 - ,regex-applicative - ,funcons-values >= 0.1.0.9 - ,random >= 1.1 - ,haskeline >= 0.8.1.2 + ,vector>=0.12 && <0.14 + ,bv >= 0.5 && < 0.6 + ,multiset >= 0.3 && <0.4 + ,split >= 0.2 && < 0.3 + ,directory >= 1.2 && < 1.4 + ,mtl >= 2.2.1 && < 2.4 + ,gll >= 0.4.1.2 && < 0.5 + ,regex-applicative >= 0.3 && < 0.4 + ,funcons-values >= 0.1.0.9 && < 0.2 + ,random >= 1.1 && < 1.4 + ,haskeline >= 0.8.1.2 && < 0.9 hs-source-dirs: src, cbs, manual default-language: Haskell2010 other-extensions: OverloadedStrings @@ -147,132 +151,132 @@ executable funcons-repl main-is: REPL.hs other-extensions: OverloadedStrings - build-depends: base >=4.8 && <= 5 - ,text >= 1.2 + build-depends: base >=4.8 && < 6 + ,text >= 2.1 && <3 ,containers >= 0.5 && < 0.7 - ,vector>=0.12 - ,bv >= 0.5 - ,multiset >= 0.3 - ,split - ,directory - ,mtl >= 2.2.1 - ,gll >= 0.4.0.9 - ,regex-applicative - ,funcons-values >= 0.1.0.9 - ,exploring-interpreters >= 1.3.0.0 - ,random >= 1.1 - ,haskeline >= 0.8.1 - ,transformers >= 0.5.6 + ,vector>=0.12 && <0.14 + ,bv >= 0.5 && < 0.6 + ,multiset >= 0.3 && <0.4 + ,split >= 0.2 && < 0.3 + ,directory >= 1.2 && < 1.4 + ,mtl >= 2.2.1 && < 2.4 + ,gll >= 0.4.1.2 && < 0.5 + ,regex-applicative >= 0.3 && < 0.4 + ,funcons-values >= 0.1.0.9 && < 0.2 + ,random >= 1.1 && < 1.4 + ,haskeline >= 0.8.1.2 && < 0.9 + ,exploring-interpreters >= 1.5 && < 1.7 + ,transformers >= 0.5.6 && < 0.7 hs-source-dirs: src, manual, cbs default-language: Haskell2010 -- ghc-options: -rtsopts - other-modules: - Funcons.Core.Computations.Abnormal.Abrupting.Abrupting - Funcons.Core.Computations.Abnormal.Breaking.Breaking - Funcons.Core.Computations.Abnormal.Continuing.Continuing - Funcons.Core.Computations.Abnormal.Controlling.Controlling - Funcons.Core.Computations.Abnormal.Failing.Failing - Funcons.Core.Computations.Abnormal.Returning.Returning - Funcons.Core.Computations.Abnormal.Sticking - Funcons.Core.Computations.Abnormal.Throwing.Throwing - Funcons.Core.Computations.AbnormalBuiltin - Funcons.Core.Computations.Normal.Binding.Binding - Funcons.Core.Computations.Normal.Flowing.Flowing - Funcons.Core.Computations.Normal.Generating.Generating - Funcons.Core.Computations.Normal.GeneratingBuiltin - Funcons.Core.Computations.Normal.Giving.Giving - Funcons.Core.Computations.Normal.Interacting.Interacting - Funcons.Core.Computations.Normal.Linking.Linking - Funcons.Core.Computations.Normal.Storing.Storing - Funcons.Core.Computations.TypesBuiltin, - -- unstable - Funcons.Core.Computations.Abnormal.Postponing.Postponing, - Funcons.Core.Computations.Normal.Indexing.Indexing, - Funcons.Core.Computations.Normal.Memos.Memos, - Funcons.Core.Computations.Threads.Multithreading.Multithreading, - Funcons.Core.Computations.Threads.Synchronising.Locks.Locks, - Funcons.Core.Computations.Threads.Synchronising.Notifications.Notifications, - Funcons.Core.Computations.Threads.Synchronising.Synchronising - Funcons.Core - Funcons.Core.Library - Funcons.Core.Manual - Funcons.Core.Values.Abstraction.Functions.Functions - Funcons.Core.Values.Abstraction.Generic.Generic - Funcons.Core.Values.Abstraction.Patterns.Patterns - Funcons.Core.Values.Abstraction.Thunks.Thunks - Funcons.Core.Values.Composite.ASTs.ASTs - Funcons.Core.Values.Composite.Bits.Bits - Funcons.Core.Values.Composite.Classes.Classes - Funcons.Core.Values.Composite.Datatypes.Datatypes - Funcons.Core.Values.Composite.DatatypesBuiltin - Funcons.Core.Values.Composite.Graphs.Graphs - Funcons.Core.Values.Composite.GraphsBuiltin - Funcons.Core.Values.Composite.Lists.Lists - Funcons.Core.Values.Composite.MapsBuiltin - Funcons.Core.Values.Composite.MultisetsBuiltin - Funcons.Core.Values.Composite.Objects.Objects - Funcons.Core.Values.Composite.Records.Records - Funcons.Core.Values.Composite.References.References - Funcons.Core.Values.Composite.Sequences.Sequences - Funcons.Core.Values.Composite.SetsBuiltin - Funcons.Core.Values.Composite.Strings.Strings - Funcons.Core.Values.Composite.Trees.Trees - Funcons.Core.Values.Composite.Tuples.Tuples - Funcons.Core.Values.Composite.Variants.Variants - Funcons.Core.Values.Composite.Vectors.Vectors - Funcons.Core.Values.Primitive.Atoms - Funcons.Core.Values.Primitive.BitsBuiltin - Funcons.Core.Values.Primitive.BoolBuiltin - Funcons.Core.Values.Primitive.Booleans.Booleans - Funcons.Core.Values.Primitive.Characters.Characters - Funcons.Core.Values.Primitive.CharactersBuiltin - Funcons.Core.Values.Primitive.Floats.Floats - Funcons.Core.Values.Primitive.FloatsBuiltin - Funcons.Core.Values.Primitive.Integers.Integers - Funcons.Core.Values.Primitive.IntegersBuiltin - Funcons.Core.Values.Primitive.Null.Null - Funcons.Core.Values.Primitive.StringsBuiltin - Funcons.Core.Values.TypesBuiltin - Funcons.Core.Values.ValueTypes.ValueTypes - Funcons.EDSL - Funcons.Entities - Funcons.Exceptions - Funcons.GLLParser - Funcons.MSOS - Funcons.Parser - Funcons.Patterns - Funcons.Printer - Funcons.RunOptions - Funcons.Simulation - Funcons.Substitution - Funcons.Tools - Funcons.TypeSubstitution - Funcons.Types - Funcons.Explorer + other-modules: + Funcons.Core.Computations.Abnormal.Abrupting.Abrupting + Funcons.Core.Computations.Abnormal.Breaking.Breaking + Funcons.Core.Computations.Abnormal.Continuing.Continuing + Funcons.Core.Computations.Abnormal.Controlling.Controlling + Funcons.Core.Computations.Abnormal.Failing.Failing + Funcons.Core.Computations.Abnormal.Returning.Returning + Funcons.Core.Computations.Abnormal.Sticking + Funcons.Core.Computations.Abnormal.Throwing.Throwing + Funcons.Core.Computations.AbnormalBuiltin + Funcons.Core.Computations.Normal.Binding.Binding + Funcons.Core.Computations.Normal.Flowing.Flowing + Funcons.Core.Computations.Normal.Generating.Generating + Funcons.Core.Computations.Normal.GeneratingBuiltin + Funcons.Core.Computations.Normal.Giving.Giving + Funcons.Core.Computations.Normal.Interacting.Interacting + Funcons.Core.Computations.Normal.Linking.Linking + Funcons.Core.Computations.Normal.Storing.Storing + Funcons.Core.Computations.TypesBuiltin, + -- unstable + Funcons.Core.Computations.Abnormal.Postponing.Postponing, + Funcons.Core.Computations.Normal.Indexing.Indexing, + Funcons.Core.Computations.Normal.Memos.Memos, + Funcons.Core.Computations.Threads.Multithreading.Multithreading, + Funcons.Core.Computations.Threads.Synchronising.Locks.Locks, + Funcons.Core.Computations.Threads.Synchronising.Notifications.Notifications, + Funcons.Core.Computations.Threads.Synchronising.Synchronising + Funcons.Core + Funcons.Core.Library + Funcons.Core.Manual + Funcons.Core.Values.Abstraction.Functions.Functions + Funcons.Core.Values.Abstraction.Generic.Generic + Funcons.Core.Values.Abstraction.Patterns.Patterns + Funcons.Core.Values.Abstraction.Thunks.Thunks + Funcons.Core.Values.Composite.ASTs.ASTs + Funcons.Core.Values.Composite.Bits.Bits + Funcons.Core.Values.Composite.Classes.Classes + Funcons.Core.Values.Composite.Datatypes.Datatypes + Funcons.Core.Values.Composite.DatatypesBuiltin + Funcons.Core.Values.Composite.Graphs.Graphs + Funcons.Core.Values.Composite.GraphsBuiltin + Funcons.Core.Values.Composite.Lists.Lists + Funcons.Core.Values.Composite.MapsBuiltin + Funcons.Core.Values.Composite.MultisetsBuiltin + Funcons.Core.Values.Composite.Objects.Objects + Funcons.Core.Values.Composite.Records.Records + Funcons.Core.Values.Composite.References.References + Funcons.Core.Values.Composite.Sequences.Sequences + Funcons.Core.Values.Composite.SetsBuiltin + Funcons.Core.Values.Composite.Strings.Strings + Funcons.Core.Values.Composite.Trees.Trees + Funcons.Core.Values.Composite.Tuples.Tuples + Funcons.Core.Values.Composite.Variants.Variants + Funcons.Core.Values.Composite.Vectors.Vectors + Funcons.Core.Values.Primitive.Atoms + Funcons.Core.Values.Primitive.BitsBuiltin + Funcons.Core.Values.Primitive.BoolBuiltin + Funcons.Core.Values.Primitive.Booleans.Booleans + Funcons.Core.Values.Primitive.Characters.Characters + Funcons.Core.Values.Primitive.CharactersBuiltin + Funcons.Core.Values.Primitive.Floats.Floats + Funcons.Core.Values.Primitive.FloatsBuiltin + Funcons.Core.Values.Primitive.Integers.Integers + Funcons.Core.Values.Primitive.IntegersBuiltin + Funcons.Core.Values.Primitive.Null.Null + Funcons.Core.Values.Primitive.StringsBuiltin + Funcons.Core.Values.TypesBuiltin + Funcons.Core.Values.ValueTypes.ValueTypes + Funcons.EDSL + Funcons.Entities + Funcons.Exceptions + Funcons.GLLParser + Funcons.MSOS + Funcons.Parser + Funcons.Patterns + Funcons.Printer + Funcons.RunOptions + Funcons.Simulation + Funcons.Substitution + Funcons.Tools + Funcons.TypeSubstitution + Funcons.Types + Funcons.Explorer executable runfct main-is: Main.hs other-extensions: OverloadedStrings - build-depends: base >=4.8 && <= 5 - ,text >= 1.2 + build-depends: base >=4.8 && < 6 + ,text >= 2.1 && <3 ,containers >= 0.5 && < 0.7 - ,vector>=0.12 - ,bv >= 0.5 - ,multiset >= 0.3 - ,split - ,directory - ,mtl >= 2.2.1 - ,gll >= 0.4.0.9 - ,regex-applicative - ,funcons-values >= 0.1.0.9 - ,exploring-interpreters >= 1.3.0.0 - ,random >= 1.1 - ,haskeline >= 0.8.1 - ,transformers >= 0.5.6 + ,vector>=0.12 && <0.14 + ,bv >= 0.5 && < 0.6 + ,multiset >= 0.3 && <0.4 + ,split >= 0.2 && < 0.3 + ,directory >= 1.2 && < 1.4 + ,mtl >= 2.2.1 && < 2.4 + ,gll >= 0.4.1.2 && < 0.5 + ,regex-applicative >= 0.3 && < 0.4 + ,funcons-values >= 0.1.0.9 && < 0.2 + ,random >= 1.1 && < 1.4 + ,haskeline >= 0.8.1.2 && < 0.9 + ,exploring-interpreters >= 1.5 && < 1.7 + ,transformers >= 0.5.6 && < 0.7 hs-source-dirs: src, manual, cbs default-language: Haskell2010 -- ghc-options: -rtsopts - other-modules: + other-modules: Funcons.Core.Computations.Abnormal.Abrupting.Abrupting Funcons.Core.Computations.Abnormal.Breaking.Breaking Funcons.Core.Computations.Abnormal.Continuing.Continuing diff --git a/manual/Funcons/Core/Computations/Normal/GeneratingBuiltin.hs b/manual/Funcons/Core/Computations/Normal/GeneratingBuiltin.hs --- a/manual/Funcons/Core/Computations/Normal/GeneratingBuiltin.hs +++ b/manual/Funcons/Core/Computations/Normal/GeneratingBuiltin.hs @@ -20,5 +20,6 @@ env <- getMutPatt "used-atom-set" [VPWildCard] env putMut "used-atom-set" [reserved_atoms] stepTermTo (TVar "P") env + reserved_atoms :: Values reserved_atoms = Set (fromList []) diff --git a/manual/Funcons/Core/Manual.hs b/manual/Funcons/Core/Manual.hs --- a/manual/Funcons/Core/Manual.hs +++ b/manual/Funcons/Core/Manual.hs @@ -41,7 +41,6 @@ --import Funcons.Core.Values.Composite.TuplesBuiltin hiding (library) import qualified Funcons.Core.Computations.Normal.GeneratingBuiltin -import qualified Funcons.Core.Computations.AbnormalBuiltin import qualified Funcons.Core.Values.Composite.SetsBuiltin import qualified Funcons.Core.Values.Composite.MultisetsBuiltin --import qualified Funcons.Core.Values.Composite.ListsBuiltin diff --git a/manual/Funcons/Core/Values/Composite/DatatypesBuiltin.hs b/manual/Funcons/Core/Values/Composite/DatatypesBuiltin.hs --- a/manual/Funcons/Core/Values/Composite/DatatypesBuiltin.hs +++ b/manual/Funcons/Core/Values/Composite/DatatypesBuiltin.hs @@ -3,7 +3,7 @@ module Funcons.Core.Values.Composite.DatatypesBuiltin where import Funcons.EDSL -import Funcons.MSOS (evalStrictSequence, evalSequence, Strictness(..)) +import Funcons.MSOS (evalStrictSequence, evalSequence) import Funcons.Operations (Values(..), Types(..), ComputationTypes(..)) import Data.Text (pack,unpack) diff --git a/manual/Funcons/Core/Values/Composite/MapsBuiltin.hs b/manual/Funcons/Core/Values/Composite/MapsBuiltin.hs --- a/manual/Funcons/Core/Values/Composite/MapsBuiltin.hs +++ b/manual/Funcons/Core/Values/Composite/MapsBuiltin.hs @@ -2,19 +2,9 @@ module Funcons.Core.Values.Composite.MapsBuiltin where -import Control.Applicative ((<$>)) - import Funcons.EDSL hiding (map_) -import Funcons.MSOS (rewrittens) -import Funcons.Core.Values.Primitive.BoolBuiltin -import Funcons.Core.Values.Composite.SetsBuiltin import qualified Funcons.Operations as VAL - -import qualified Data.Set as S -import qualified Data.Map as M - -import Data.Foldable (foldrM) library = libFromList [ ("map-empty", fromNullaryValOp map_empty_ VAL.map_empty_) diff --git a/manual/Funcons/Core/Values/Composite/SetsBuiltin.hs b/manual/Funcons/Core/Values/Composite/SetsBuiltin.hs --- a/manual/Funcons/Core/Values/Composite/SetsBuiltin.hs +++ b/manual/Funcons/Core/Values/Composite/SetsBuiltin.hs @@ -5,8 +5,6 @@ import Funcons.EDSL hiding (set_) import qualified Funcons.Operations as VAL -import qualified Data.Set as S - library = libFromList [ ("set", fromValOp set_ VAL.set_) , ("set-empty", fromNullaryValOp set_empty_ VAL.set_empty_) diff --git a/manual/Funcons/Core/Values/Primitive/FloatsBuiltin.hs b/manual/Funcons/Core/Values/Primitive/FloatsBuiltin.hs --- a/manual/Funcons/Core/Values/Primitive/FloatsBuiltin.hs +++ b/manual/Funcons/Core/Values/Primitive/FloatsBuiltin.hs @@ -3,8 +3,7 @@ module Funcons.Core.Values.Primitive.FloatsBuiltin where import Funcons.EDSL -import Funcons.Operations (Values(..), ComputationTypes(..), Types(..), isIEEEFormat, doubleFromIEEEFormat, tobool) -import Funcons.Core.Values.Primitive.BoolBuiltin +import Funcons.Operations (Values(..), isIEEEFormat, doubleFromIEEEFormat, tobool) import Funcons.Core.Values.Primitive.IntegersBuiltin import Data.Fixed (mod') diff --git a/manual/Funcons/Core/Values/Primitive/IntegersBuiltin.hs b/manual/Funcons/Core/Values/Primitive/IntegersBuiltin.hs --- a/manual/Funcons/Core/Values/Primitive/IntegersBuiltin.hs +++ b/manual/Funcons/Core/Values/Primitive/IntegersBuiltin.hs @@ -5,8 +5,6 @@ import Funcons.EDSL hiding (integers_) import qualified Funcons.Operations as VAL -import Funcons.Core.Values.Primitive.BoolBuiltin - library = libFromList [ ("integer-add", fromValOp integer_add_ VAL.integer_add_) , ("int-add", fromValOp integer_add_ VAL.integer_add_) diff --git a/manual/Funcons/MetaProgramming.hs b/manual/Funcons/MetaProgramming.hs --- a/manual/Funcons/MetaProgramming.hs +++ b/manual/Funcons/MetaProgramming.hs @@ -8,12 +8,11 @@ import Funcons.MSOS import Funcons.EDSL import Funcons.Types -import Funcons.Patterns import Funcons.RunOptions import Funcons.Simulation import Data.Maybe (fromJust) -import Data.Text (pack, unpack) +import Data.Text (pack, unpack, Text) import qualified Data.Map as M import qualified Data.Set as S @@ -94,6 +93,7 @@ putMut store_entity [Map M.empty] withInh env_entity [env] (ctRel f) +env_entity, store_entity, atom_gen_entity :: Text env_entity = "environment" store_entity = "store" atom_gen_entity = "used-atom-set" diff --git a/src/Funcons/Entities.hs b/src/Funcons/Entities.hs --- a/src/Funcons/Entities.hs +++ b/src/Funcons/Entities.hs @@ -25,10 +25,8 @@ import Funcons.Exceptions import Funcons.Patterns -import Control.Applicative import Control.Arrow import qualified Data.Map as M -import Data.Text -- defaults -- | A list of 'EntityDefault's is used to declare (and possibly initialise) diff --git a/src/Funcons/GLLParser.hs b/src/Funcons/GLLParser.hs --- a/src/Funcons/GLLParser.hs +++ b/src/Funcons/GLLParser.hs @@ -63,11 +63,15 @@ , keychars = fct_keychars } +lexer :: SubsumesToken t => String -> [t] lexer = GLL.Combinators.lexer fct_lexerSettings +lexerEither :: SubsumesToken t => String -> Either String [t] lexerEither = GLL.Combinators.lexerEither fct_lexerSettings +fct_keywords :: [String] fct_keywords = ["void", "depends", "forall", "type_abs" ,"typevar", "?", "*", "+", "|->", "=>"] +fct_keychars :: [Char] fct_keychars = "{}(),'\"[]|^&~" lName = (:) <$> psym isLower <*> many (psym (\c -> isAlphaNum c || c == '-')) @@ -114,7 +118,8 @@ pFunconss = "FUNCONS-SEQUENCE" <::= Left <$$> pFuncons <||> Right . merge <$$> parens (multipleSepBy pFunconss (keychar ',')) - where merge = foldr op [] + where merge :: [Either Funcons [Funcons]] -> [Funcons] + merge = foldr op [] where op (Left f) acc = f:acc op (Right fs) acc = fs++acc @@ -139,7 +144,8 @@ <||> string__ <$$> string_lit <||> mk_integers . toInteger <$$> int_lit <||> IEEE_Float_64 . fst . head . readFloat <$$> pRatioAsString - where pRatioAsString = "RATIOasSTRING" -- NOT OK, would parse "-2.-3" + where pRatioAsString :: Parser String + pRatioAsString = "RATIOasSTRING" -- NOT OK, would parse "-2.-3" <:=> (\m l -> show m ++ "." ++ show l) <$$> int_lit <** keychar '.' <**> int_lit diff --git a/src/Funcons/MSOS.hs b/src/Funcons/MSOS.hs --- a/src/Funcons/MSOS.hs +++ b/src/Funcons/MSOS.hs @@ -46,15 +46,11 @@ import Funcons.Simulation import qualified Funcons.Operations as VAL -import Control.Applicative -import Control.Arrow ((***)) -import Control.Monad.Writer hiding ((<>)) -import Control.Monad.Fail +import Control.Monad (liftM, ap) import Data.Function (on) import Data.Maybe (isJust, isNothing, fromJust) import Data.List (foldl', intercalate, partition, sortBy) import Data.Text (unpack) -import Data.Semigroup import qualified Data.Map as M @@ -207,15 +203,13 @@ (Either IException a, RewriteState, RewriteWriterr))} instance Applicative Rewrite where - pure = return + pure a = Rewrite (\_ st -> (Right a, st, mempty)) (<*>) = ap instance Functor Rewrite where fmap = liftM instance Monad Rewrite where - return a = Rewrite (\_ st -> (Right a, st, mempty)) - (Rewrite f) >>= k = Rewrite (\ctxt st -> let res1@(e_a1,st1,cs1) = f ctxt st in case e_a1 of @@ -225,11 +219,10 @@ in (a2,st2,cs1 <> cs2)) instance Semigroup RewriteWriterr where - (<>) = mappend + (RewriteWriterr cs1) <> (RewriteWriterr cs2) = RewriteWriterr (cs1 <> cs2) instance Monoid RewriteWriterr where mempty = RewriteWriterr mempty - (RewriteWriterr cs1) `mappend` (RewriteWriterr cs2) = RewriteWriterr (cs1 `mappend` cs2) liftRewrite :: Rewrite a -> MSOS a liftRewrite ev = MSOS $ \ctxt mut -> @@ -315,15 +308,13 @@ -> m (Either IException a, MSOSState m, MSOSWriter)) } instance Applicative MSOS where - pure = return + pure a = MSOS (\_ mut -> return (Right a,mut,mempty)) (<*>) = ap instance Functor MSOS where fmap = liftM instance Monad MSOS where - return a = MSOS (\_ mut -> return (Right a,mut,mempty)) - (MSOS f) >>= k = MSOS (\ctxt mut -> do res1@(e_a1,mut1,wr1) <- f ctxt mut case e_a1 of @@ -337,12 +328,11 @@ fail = liftRewrite . internal instance Semigroup MSOSWriter where - (<>) = mappend + (MSOSWriter x1 x2 x3) <> (MSOSWriter y1 y2 y3) = + MSOSWriter (x1 `unionCTRL` y1) (x2 `unionOUT` y2) (x3 `mappend` y3) instance Monoid MSOSWriter where mempty = MSOSWriter mempty mempty mempty - (MSOSWriter x1 x2 x3) `mappend` (MSOSWriter y1 y2 y3) = - MSOSWriter (x1 `unionCTRL` y1) (x2 `unionOUT` y2) (x3 `mappend` y3) -- | A map storing the values of /mutable/ entities. type Mutable = M.Map Name [Values] @@ -507,12 +497,11 @@ data Counters = Counters !Int !Int !Int !Int !Int !Int !Int !Int instance Semigroup Counters where - (<>) = mappend + (Counters x1 x2 x3 x4 x5 x6 x7 x8) <> (Counters y1 y2 y3 y4 y5 y6 y7 y8) = + Counters (x1+y1) (x2+y2) (x3+y3) (x4+y4) (x5+y5) (x6+y6) (x7+y7) (x8+y8) instance Monoid Counters where mempty = Counters 0 0 0 0 0 0 0 0 - (Counters x1 x2 x3 x4 x5 x6 x7 x8) `mappend` (Counters y1 y2 y3 y4 y5 y6 y7 y8) = - Counters (x1+y1) (x2+y2) (x3+y3) (x4+y4) (x5+y5) (x6+y6) (x7+y7) (x8+y8) emptyCounters x1 x2 x3 x4 x5 x6 x7 x8 = mempty { ewriter = mempty {counters = Counters x1 x2 x3 x4 x5 x6 x7 x8}} @@ -549,6 +538,7 @@ ppCounters cs = "number of (" ++ counterKeys ++ "): (" ++ displayCounters cs ++ ")" +counterKeys :: String counterKeys = "restarts,rewrites,(attempts),steps,refocus,premises,backtracking(outer),backtracking(inner)" displayCounters (Counters steps rewrites rattempts restarts refocus delegations bout bin) = intercalate "," $ @@ -863,7 +853,8 @@ evalSequence :: [Strictness] -> [Funcons] -> ([Funcons] -> Rewrite Rewritten) -> ([Funcons] -> Funcons) -> Rewrite Rewritten evalSequence strns args cont cons = do - let args_map = zip [1..] (zip strns args) + let args_map :: [(Int, (Strictness, Funcons))] + args_map = zip [1..] (zip strns args) let evalSeqAux args_done args_undone | null args_undone = cont (map (snd . snd) (sorter args_done)) @@ -891,6 +882,7 @@ where isDone (NonStrict, _) = True isDone (Strict, FValue _) = True isDone (Strict,_) = False + sorter :: [(Int, b)] -> [(Int, b)] sorter = sortBy (compare `on` fst) -- | Yield an 'MSOS' computation as a fully rewritten term. diff --git a/src/Funcons/Patterns.hs b/src/Funcons/Patterns.hs --- a/src/Funcons/Patterns.hs +++ b/src/Funcons/Patterns.hs @@ -9,14 +9,11 @@ import Funcons.Types import Funcons.Substitution import Funcons.Exceptions -import Funcons.Operations (isGround) import Funcons.RunOptions (SourceOfND(..)) -import Control.Applicative -import Control.Monad (foldM, forM) +import Control.Monad (forM) import Data.Function (on) import Data.List (sortBy, intercalate) -import Data.Monoid import Data.Text (unpack) import Data.Foldable (toList) import qualified Data.Map as M @@ -58,7 +55,8 @@ -- sorts the result in order of preference sortWithPref :: [(Int, Env)] -> [(Int, Env)] sortWithPref = sortBy (comparison `on` fst) - where comparison = case mty of + where comparison :: Ord a => a -> a -> Ordering + comparison = case mty of Nothing -> compare -- no annotation => shortest match Just _ -> flip compare -- annoration => longest match diff --git a/src/Funcons/RunOptions.hs b/src/Funcons/RunOptions.hs --- a/src/Funcons/RunOptions.hs +++ b/src/Funcons/RunOptions.hs @@ -11,7 +11,7 @@ import qualified Data.Map as M import Control.Monad (when) import GLL.Types.TypeCompose (OO(..)) -import Data.Text (pack) +import Data.Text (pack, Text) import Data.List (isSuffixOf, isPrefixOf) import Data.List.Split (splitOn) @@ -158,16 +158,20 @@ inputValues :: RunOptions -> InputValues inputValues = given_inputs +booleanOptions :: [String] booleanOptions = ["refocus", "full-environments", "hide-result", "display-steps" ,"no-abrupt-termination", "interactive-mode", "string-inputs" ,"format-string-outputs", "hide-tests", "show-output-only" ,"auto-config", "csv", "csv-keys"] +booleanOptions_ :: [String] booleanOptions_ = map ("--" ++) booleanOptions +stringOptions :: [String] stringOptions = ["display-mutable-entity", "hide-output-entity" , "hide-control-entity", "hide-input-entity", "max-restarts" , "seed", "non-deterministic"] +stringOptions_ :: [String] stringOptions_ = map ("--" ++) stringOptions allOptions = "funcon-term" : booleanOptions ++ stringOptions @@ -233,7 +237,9 @@ , keychars = (keychars fct_lexerSettings) ++ cfg_keychars } +cfg_keychars :: [Char] cfg_keychars = ":;=" +cfg_keywords :: [String] cfg_keywords = allOptions ++ ["result-term", "general", "tests", "funcons", "inputs"] pRunOptions :: Parser RunOptions @@ -277,7 +283,8 @@ pTestOutcomes :: Parser RunOptions pTestOutcomes = "TEST-OUTCOMES" <:=> toOptions <$$> (M.union <$$> pResult <**> pEntityValues) - where pResult = mStoreResult <$$> + where pResult :: AltExpr Token (M.Map Text [Funcons]) + pResult = mStoreResult <$$> optional (id <$$ keyword "result-term" <** keychar ':' <**> pFunconsSeq <** keychar ';') where mStoreResult Nothing = M.empty diff --git a/src/Funcons/Simulation.hs b/src/Funcons/Simulation.hs --- a/src/Funcons/Simulation.hs +++ b/src/Funcons/Simulation.hs @@ -3,12 +3,10 @@ module Funcons.Simulation where import Funcons.Types -import Funcons.Exceptions import Funcons.Printer import Funcons.Parser (fvalue_parse_either) import Funcons.RunOptions -import Control.Applicative import Control.Monad.State import System.Console.Haskeline import qualified Data.Map as M diff --git a/src/Funcons/Substitution.hs b/src/Funcons/Substitution.hs --- a/src/Funcons/Substitution.hs +++ b/src/Funcons/Substitution.hs @@ -11,9 +11,7 @@ import Funcons.Types import Funcons.MSOS -import Control.Applicative import Control.Monad -import Data.Monoid import qualified Data.Map as M -- | An environment mapping meta-variables to funcon terms. diff --git a/src/Funcons/Types.hs b/src/Funcons/Types.hs --- a/src/Funcons/Types.hs +++ b/src/Funcons/Types.hs @@ -7,14 +7,11 @@ import qualified Funcons.Operations as VAL hiding (SortErr, ValueOp) import Funcons.Operations hiding (Name, Values, ComputationTypes, Types, isMap, isNull, isSet, map_empty_, isEnv, isDefinedVal, isChar, isVec, isType, isList, isNat, isInt, atoms_, integers_, values_, set_, list_, tuple_, atom_, nulltype_, non_null_values_, types_, value_types_, toList, isList, libFromList, listUnites, null) -import qualified Data.Char as C import qualified Data.Map as M import qualified Data.Set as S -import qualified Data.MultiSet as MS import qualified Data.Vector as V import Data.Maybe (isJust) import Data.Text (Text) -import Data.Ratio type MetaVar = String type Name = Text