packages feed

funcons-tools 0.1.0.0 → 0.2.0.1

raw patch · 201 files changed

+5822/−6694 lines, 201 filesdep +TypeComposedep +funcons-valuesdep +glldep −parsecdep ~basedep ~bvdep ~vector

Dependencies added: TypeCompose, funcons-values, gll, random-strings, regex-applicative

Dependencies removed: parsec

Dependency ranges changed: base, bv, vector

Files

− cbs/Funcons/Core/Abstractions/Closures/Close.hs 
@@ -1,26 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Abstractions/Closures/close.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Abstractions.Closures.Close where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("close",StrictFuncon stepClose)]---- |--- /close(_)/ closes a thunked computation with respect to the---   current environment.-close_ fargs = FApp "close" (FTuple fargs)-stepClose fargs =-    evalRules [] [step1]-    where step1 = do-            let env = emptyEnv-            env <- lifted_vsMatch fargs [VPAnnotated (VPMetaVar "F") (TApp "thunks" (TTuple [TSortComputes (TName "values")]))] env-            env <- getInhPatt "environment" (VPMetaVar "Rho") env-            stepTermTo (TApp "thunk" (TTuple [TApp "closure" (TTuple [TApp "force" (TTuple [TVar "F"]),TVar "Rho"])])) env
− cbs/Funcons/Core/Abstractions/Closures/Closure.hs 
@@ -1,31 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Abstractions/Closures/closure.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Abstractions.Closures.Closure where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("closure",PartiallyStrictFuncon [NonStrict,Strict] stepClosure)]---- |--- /closure(X,Rho)/ evaluates /X/ using /Rho/ as the current environment.-closure_ fargs = FApp "closure" (FTuple fargs)-stepClosure fargs@[arg1,arg2] =-    evalRules [rewrite1] [step1]-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PAnnotated (PMetaVar "V") (TName "values"),PAnnotated (PWildCard) (TName "environments")] env-            rewriteTermTo (TVar "V") env-          step1 = do-            let env = emptyEnv-            env <- lifted_fsMatch fargs [PMetaVar "X",PAnnotated (PMetaVar "Rho") (TName "environments")] env-            env <- getInhPatt "environment" (VPWildCard) env-            env <- withInhTerm "environment" (TTuple [TVar "Rho"]) env (premise (TVar "X") (PMetaVar "X'") env)-            stepTermTo (TApp "closure" (TTuple [TVar "X'",TVar "Rho"])) env-stepClosure fargs = sortErr (FApp "closure" (FTuple fargs)) "invalid number of arguments"
− cbs/Funcons/Core/Abstractions/Functions/Apply.hs 
@@ -1,24 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Abstractions/Functions/apply.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Abstractions.Functions.Apply where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("apply",StrictFuncon stepApply)]---- |--- /apply(F,V)/ applies the function /F/ to the value /V/ .-apply_ fargs = FApp "apply" (FTuple fargs)-stepApply fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "F") (TName "values"),VPAnnotated (VPMetaVar "V") (TName "values")] env-            rewriteTermTo (TApp "give" (TTuple [TVar "V",TApp "force" (TTuple [TVar "F"])])) env
− cbs/Funcons/Core/Abstractions/Functions/BindingLambda.hs 
@@ -1,26 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Abstractions/Functions/binding-lambda.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Abstractions.Functions.BindingLambda where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("binding-lambda",PartiallyStrictFuncon [Strict,NonStrict] stepBinding_lambda)]---- |--- /binding-lambda(B,E)/ computes a statically scoped function (i.e. a closed---   thunk).  When applied to a value /V/ , free occurrences of /bound(B)/ in /E/ refer to /V/ .-binding_lambda_ fargs = FApp "binding-lambda" (FTuple fargs)-stepBinding_lambda fargs@[arg1,arg2] =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PAnnotated (PMetaVar "B") (TName "values"),PMetaVar "E"] env-            rewriteTermTo (TApp "lambda" (TTuple [TApp "scope" (TTuple [TApp "bind" (TTuple [TVar "B",TName "given"]),TVar "E"])])) env-stepBinding_lambda fargs = sortErr (FApp "binding-lambda" (FTuple fargs)) "invalid number of arguments"
− cbs/Funcons/Core/Abstractions/Functions/Compose.hs 
@@ -1,25 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Abstractions/Functions/compose.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Abstractions.Functions.Compose where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("compose",StrictFuncon stepCompose)]---- |--- /compose(G,F)/ composes two functions /G/ and /F/ by---   giving the result of /F/ as the argument to /G/ .-compose_ fargs = FApp "compose" (FTuple fargs)-stepCompose fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "G") (TName "values"),VPAnnotated (VPMetaVar "F") (TName "values")] env-            rewriteTermTo (TApp "thunk" (TTuple [TApp "apply" (TTuple [TVar "G",TApp "apply" (TTuple [TVar "F",TName "given"])])])) env
− cbs/Funcons/Core/Abstractions/Functions/Curry.hs 
@@ -1,26 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Abstractions/Functions/curry.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Abstractions.Functions.Curry where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("curry",StrictFuncon stepCurry)]---- |--- /curry(F)/ converts a function that takes a pair of arguments into a function---   that takes the first argument of the pair, and returns a function that takes---   the second argument of the pair.-curry_ fargs = FApp "curry" (FTuple fargs)-stepCurry fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "F") (TName "values")] env-            rewriteTermTo (TApp "thunk" (TTuple [TApp "partial-apply" (TTuple [TVar "F",TName "given"])])) env
− cbs/Funcons/Core/Abstractions/Functions/Lambda.hs 
@@ -1,25 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Abstractions/Functions/lambda.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Abstractions.Functions.Lambda where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("lambda",NonStrictFuncon stepLambda)]---- |--- /lambda(E)/ computes a statically scoped function (i.e. a closed thunk).---   When applied to a value /V/ , free occurrences of /given/ in /E/ refer to /V/ .-lambda_ fargs = FApp "lambda" (FTuple fargs)-stepLambda fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PMetaVar "E"] env-            rewriteTermTo (TApp "close" (TTuple [TApp "thunk" (TTuple [TVar "E"])])) env
− cbs/Funcons/Core/Abstractions/Functions/PartialApply.hs 
@@ -1,26 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Abstractions/Functions/partial-apply.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Abstractions.Functions.PartialApply where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("partial-apply",StrictFuncon stepPartial_apply)]---- |--- /partial-apply(F,V)/ provides /V/ as the first argument to a function---   expecting a pair of arguments, returning a function expecting only the---   second argument.-partial_apply_ fargs = FApp "partial-apply" (FTuple fargs)-stepPartial_apply fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "F") (TName "values"),VPAnnotated (VPMetaVar "V") (TName "values")] env-            rewriteTermTo (TApp "thunk" (TTuple [TApp "apply" (TTuple [TVar "F",TTuple [TVar "V",TName "given"]])])) env
− cbs/Funcons/Core/Abstractions/Functions/Supply.hs 
@@ -1,26 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Abstractions/Functions/supply.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Abstractions.Functions.Supply where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("supply",StrictFuncon stepSupply)]---- |--- /supply(V,F)/ supplies /V/ as the argument to the function /F/ , without---   executing the function.  The result is a thunk that does not depend on---   an argument when forced.-supply_ fargs = FApp "supply" (FTuple fargs)-stepSupply fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values"),VPAnnotated (VPMetaVar "F") (TName "values")] env-            rewriteTermTo (TApp "thunk" (TTuple [TApp "apply" (TTuple [TVar "F",TVar "V"])])) env
− cbs/Funcons/Core/Abstractions/Functions/Uncurry.hs 
@@ -1,25 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Abstractions/Functions/uncurry.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Abstractions.Functions.Uncurry where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("uncurry",StrictFuncon stepUncurry)]---- |--- /uncurry(F)/ converts a function that computes a function into a single---   function that takes both arguments as a pair.-uncurry_ fargs = FApp "uncurry" (FTuple fargs)-stepUncurry fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "F") (TName "values")] env-            rewriteTermTo (TApp "thunk" (TTuple [TApp "apply" (TTuple [TApp "apply" (TTuple [TVar "F",TName "given1"]),TName "given2"])])) env
− cbs/Funcons/Core/Abstractions/IsGroundValue.hs 
@@ -1,69 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Abstractions/is-ground-value.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Abstractions.IsGroundValue where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("is-ground-value",StrictFuncon stepIs_ground_value)]---- |--- A ground-value is any (potentially composite) value that---    does not contain thunks anywhere within it.-is_ground_value_ fargs = FApp "is-ground-value" (FTuple fargs)-stepIs_ground_value fargs =-    evalRules [rewrite1,rewrite2,rewrite3,rewrite4,rewrite5,rewrite6,rewrite7,rewrite8,rewrite9,rewrite10] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPMetaVar "V"] env-            env <- sideCondition (SCNotInSort (TVar "V") (TApp "thunks" (TTuple [TSortComputes (TName "values")]))) env-            env <- sideCondition (SCNotInSort (TVar "V") (TName "algebraic-datatypes")) env-            env <- sideCondition (SCNotInSort (TVar "V") (TApp "lists" (TTuple [TName "values"]))) env-            env <- sideCondition (SCNotInSort (TVar "V") (TApp "maps" (TTuple [TName "values",TName "values"]))) env-            env <- sideCondition (SCNotInSort (TVar "V") (TApp "multisets" (TTuple [TName "values"]))) env-            env <- sideCondition (SCNotInSort (TVar "V") (TApp "sets" (TTuple [TName "values"]))) env-            env <- sideCondition (SCNotInSort (TVar "V") (TApp "tuples" (TTuple [TName "values",TSortSeq (TName "values") PlusOp]))) env-            env <- sideCondition (SCNotInSort (TVar "V") (TApp "vectors" (TTuple [TName "values"]))) env-            rewriteTo (FName "true")-          rewrite2 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPWildCard) (TApp "thunks" (TTuple [TSortComputes (TName "values")]))] env-            rewriteTo (FName "false")-          rewrite3 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "A") (TName "algebraic-datatypes")] env-            rewriteTermTo (TApp "is-ground-value" (TTuple [TApp "algebraic-datatype-value" (TTuple [TVar "A"])])) env-          rewrite4 = do-            let env = emptyEnv-            env <- vsMatch fargs [PList []] env-            rewriteTo (FName "true")-          rewrite5 = do-            let env = emptyEnv-            env <- vsMatch fargs [PList [VPMetaVar "V",VPSeqVar "V*" StarOp]] env-            rewriteTermTo (TApp "and" (TTuple [TApp "is-ground-value" (TTuple [TVar "V"]),TApp "is-ground-value" (TList [TVar "V*"])])) env-          rewrite6 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "M") (TApp "maps" (TTuple [TName "values",TName "values"]))] env-            rewriteTermTo (TApp "is-ground-value" (TTuple [TApp "map-to-list" (TTuple [TVar "M"])])) env-          rewrite7 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "M") (TApp "multisets" (TTuple [TName "values"]))] env-            rewriteTermTo (TApp "is-ground-value" (TTuple [TApp "multiset-to-set" (TTuple [TVar "M"])])) env-          rewrite8 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "S") (TApp "sets" (TTuple [TName "values"]))] env-            rewriteTermTo (TApp "is-ground-value" (TTuple [TApp "set-to-list" (TTuple [TVar "S"])])) env-          rewrite9 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values"),VPAnnotated (VPSeqVar "V+" PlusOp) (TName "values")] env-            rewriteTermTo (TApp "and" (TTuple [TApp "is-ground-value" (TTuple [TVar "V"]),TApp "is-ground-value" (TTuple [TVar "V+"])])) env-          rewrite10 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TApp "vectors" (TTuple [TName "values"]))] env-            rewriteTermTo (TApp "is-ground-value" (TTuple [TApp "vector-to-list" (TTuple [TVar "V"])])) env
− cbs/Funcons/Core/Abstractions/Patterns/Case.hs 
@@ -1,27 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Abstractions/Patterns/case.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Abstractions.Patterns.Case where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("case",PartiallyStrictFuncon [Strict,NonStrict] stepCase)]---- |--- /case(P,X)/ attempts to match the (potentially composite) /given-value/ against the (potentially composite) pattern /P/ .---    If successful, /X/ is executed in the scope of any computed bindings.---    Otherwise, it fails.-case_ fargs = FApp "case" (FTuple fargs)-stepCase fargs@[arg1,arg2] =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PAnnotated (PMetaVar "P") (TName "values"),PMetaVar "F"] env-            rewriteTermTo (TApp "scope" (TTuple [TApp "match" (TTuple [TName "given",TVar "P"]),TVar "F"])) env-stepCase fargs = sortErr (FApp "case" (FTuple fargs)) "invalid number of arguments"
− cbs/Funcons/Core/Abstractions/Patterns/Match.hs 
@@ -1,70 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Abstractions/Patterns/match.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Abstractions.Patterns.Match where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("match",StrictFuncon stepMatch)]---- |--- /match(V,P)/ matches the (potentially composite) value /V/ against the---   (potentially composite) pattern /P/ .-match_ fargs = FApp "match" (FTuple fargs)-stepMatch fargs =-    evalRules [rewrite1,rewrite2,rewrite3,rewrite4,rewrite5,rewrite6,rewrite7,rewrite8,rewrite9,rewrite10] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values"),VPAnnotated (VPMetaVar "P") (TApp "thunks" (TTuple [TSortComputesFrom (TName "values") (TName "environments")]))] env-            rewriteTermTo (TApp "apply" (TTuple [TVar "P",TVar "V"])) env-          rewrite2 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values"),VPMetaVar "P"] env-            env <- sideCondition (SCNotInSort (TVar "P") (TApp "thunks" (TTuple [TSortComputesFrom (TName "values") (TName "environments")]))) env-            env <- sideCondition (SCNotInSort (TVar "P") (TName "algebraic-datatypes")) env-            env <- sideCondition (SCNotInSort (TVar "P") (TApp "lists" (TTuple [TName "values"]))) env-            env <- sideCondition (SCNotInSort (TVar "P") (TApp "maps" (TTuple [TName "values",TName "values"]))) env-            env <- sideCondition (SCNotInSort (TVar "P") (TApp "tuples" (TTuple [TName "values",TSortSeq (TName "values") PlusOp]))) env-            env <- sideCondition (SCNotInSort (TVar "P") (TApp "vectors" (TTuple [TName "values"]))) env-            rewriteTermTo (TApp "sequential" (TTuple [TApp "check-true" (TTuple [TApp "is-equal" (TTuple [TVar "V",TVar "P"])]),TName "map-empty"])) env-          rewrite3 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values"),VPAnnotated (VPMetaVar "P") (TName "algebraic-datatypes")] env-            rewriteTermTo (TApp "sequential" (TTuple [TApp "check-true" (TTuple [TApp "is-in-type" (TTuple [TVar "V",TName "algebraic-datatypes"])]),TApp "check-true" (TTuple [TApp "is-equal" (TTuple [TApp "algebraic-datatype-constructor" (TTuple [TVar "V"]),TApp "algebraic-datatype-constructor" (TTuple [TVar "P"])])]),TApp "match" (TTuple [TApp "algebraic-datatype-value" (TTuple [TVar "V"]),TApp "algebraic-datatype-value" (TTuple [TVar "P"])])])) env-          rewrite4 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values"),PList []] env-            rewriteTermTo (TApp "sequential" (TTuple [TApp "check-true" (TTuple [TApp "is-equal" (TTuple [TVar "V",TList []])]),TName "map-empty"])) env-          rewrite5 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values"),PList [VPMetaVar "P",VPSeqVar "P*" StarOp]] env-            rewriteTermTo (TApp "sequential" (TTuple [TApp "check-true" (TTuple [TApp "is-in-type" (TTuple [TVar "V",TApp "lists" (TTuple [TName "values"])])]),TApp "check-true" (TTuple [TApp "not" (TTuple [TApp "is-nil" (TTuple [TVar "V"])])]),TApp "map-unite" (TTuple [TApp "match" (TTuple [TApp "head" (TTuple [TVar "V"]),TVar "P"]),TApp "match" (TTuple [TApp "tail" (TTuple [TVar "V"]),TList [TVar "P*"]])])])) env-          rewrite6 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values"),VPMetaVar "P"] env-            env <- sideCondition (SCEquality (TVar "P") (TName "map-empty")) env-            rewriteTermTo (TApp "sequential" (TTuple [TApp "check-true" (TTuple [TApp "is-equal" (TTuple [TVar "V",TName "map-empty"])]),TName "map-empty"])) env-          rewrite7 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "VM") (TName "values"),VPAnnotated (VPMetaVar "PM") (TApp "maps" (TTuple [TName "values",TName "values"]))] env-            env <- sideCondition (SCPatternMatch (TApp "some-element" (TTuple [TApp "domain" (TTuple [TVar "PM"])])) (VPMetaVar "K")) env-            rewriteTermTo (TApp "sequential" (TTuple [TApp "check-true" (TTuple [TApp "is-in-type" (TTuple [TVar "VM",TApp "maps" (TTuple [TName "values",TName "values"])])]),TApp "check-true" (TTuple [TApp "is-equal" (TTuple [TApp "domain" (TTuple [TVar "PM"]),TApp "domain" (TTuple [TVar "VM"])])]),TApp "map-unite" (TTuple [TApp "match" (TTuple [TApp "lookup" (TTuple [TVar "K",TVar "VM"]),TApp "lookup" (TTuple [TVar "K",TVar "PM"])]),TApp "match" (TTuple [TApp "map-delete" (TTuple [TVar "VM",TSet [TVar "K"]]),TApp "map-delete" (TTuple [TVar "PM",TSet [TVar "K"]])])])])) env-          rewrite8 = do-            let env = emptyEnv-            env <- vsMatch fargs [PTuple [VPAnnotated (VPMetaVar "V") (TName "values"),VPAnnotated (VPSeqVar "V+" PlusOp) (TName "values")],PTuple [VPAnnotated (VPMetaVar "P") (TName "values"),VPAnnotated (VPSeqVar "P+" PlusOp) (TName "values")]] env-            rewriteTermTo (TApp "map-unite" (TTuple [TApp "match" (TTuple [TVar "V",TVar "P"]),TApp "match" (TTuple [TTuple [TVar "V+"],TTuple [TVar "P+"]])])) env-          rewrite9 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values"),PTuple [VPAnnotated (VPMetaVar "P") (TName "values"),VPAnnotated (VPSeqVar "P+" PlusOp) (TName "values")]] env-            env <- sideCondition (SCNotInSort (TVar "V") (TApp "tuples" (TTuple [TName "values",TSortSeq (TName "values") PlusOp]))) env-            rewriteTo (FName "fail")-          rewrite10 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values"),VPAnnotated (VPMetaVar "P") (TApp "vectors" (TTuple [TName "patterns"]))] env-            rewriteTermTo (TApp "sequential" (TTuple [TApp "check-true" (TTuple [TApp "is-in-type" (TTuple [TVar "V",TApp "vectors" (TTuple [TName "values"])])]),TApp "match" (TTuple [TApp "vector-to-list" (TTuple [TVar "V"]),TApp "vector-to-list" (TTuple [TVar "P"])])])) env
− cbs/Funcons/Core/Abstractions/Patterns/MatchLoosely.hs 
@@ -1,81 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Abstractions/Patterns/match-loosely.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Abstractions.Patterns.MatchLoosely where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("match-loosely",StrictFuncon stepMatch_loosely)]---- |--- /match-loosely(V,P)/ loosely matches the (potentially composite) value /V/ against the (potentially composite) pattern /P/ .  In the case of /sets/ ,---   /maps/ and /vectors/ , the pattern may be a sub-set/sub-multiset/sub-map/---   sub-vector of the value being matched against (recursively).-match_loosely_ fargs = FApp "match-loosely" (FTuple fargs)-stepMatch_loosely fargs =-    evalRules [rewrite1,rewrite2,rewrite3,rewrite4,rewrite5,rewrite6,rewrite7,rewrite8,rewrite9,rewrite10,rewrite11,rewrite12] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values"),VPAnnotated (VPMetaVar "P") (TApp "thunks" (TTuple [TSortComputesFrom (TName "values") (TName "environments")]))] env-            rewriteTermTo (TApp "apply" (TTuple [TVar "P",TVar "V"])) env-          rewrite2 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values"),VPMetaVar "P"] env-            env <- sideCondition (SCNotInSort (TVar "P") (TApp "thunks" (TTuple [TSortComputesFrom (TName "values") (TName "environments")]))) env-            env <- sideCondition (SCNotInSort (TVar "P") (TName "algebraic-datatypes")) env-            env <- sideCondition (SCNotInSort (TVar "P") (TApp "lists" (TTuple [TName "values"]))) env-            env <- sideCondition (SCNotInSort (TVar "P") (TApp "maps" (TTuple [TName "values",TName "values"]))) env-            env <- sideCondition (SCNotInSort (TVar "P") (TApp "multisets" (TTuple [TName "values"]))) env-            env <- sideCondition (SCNotInSort (TVar "P") (TApp "sets" (TTuple [TName "values"]))) env-            env <- sideCondition (SCNotInSort (TVar "P") (TApp "tuples" (TTuple [TName "values",TSortSeq (TName "values") PlusOp]))) env-            env <- sideCondition (SCNotInSort (TVar "P") (TApp "vectors" (TTuple [TName "values"]))) env-            rewriteTermTo (TApp "sequential" (TTuple [TApp "check-true" (TTuple [TApp "is-equal" (TTuple [TVar "V",TVar "P"])]),TName "map-empty"])) env-          rewrite3 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values"),VPAnnotated (VPMetaVar "P") (TName "algebraic-datatypes")] env-            rewriteTermTo (TApp "sequential" (TTuple [TApp "check-true" (TTuple [TApp "is-in-type" (TTuple [TVar "V",TName "algebraic-datatypes"])]),TApp "check-true" (TTuple [TApp "is-equal" (TTuple [TApp "algebraic-datatype-constructor" (TTuple [TVar "V"]),TApp "algebraic-datatype-constructor" (TTuple [TVar "P"])])]),TApp "match-loosely" (TTuple [TApp "algebraic-datatype-value" (TTuple [TVar "V"]),TApp "algebraic-datatype-value" (TTuple [TVar "P"])])])) env-          rewrite4 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values"),PList []] env-            rewriteTermTo (TApp "sequential" (TTuple [TApp "check-true" (TTuple [TApp "is-equal" (TTuple [TVar "V",TList []])]),TName "map-empty"])) env-          rewrite5 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values"),PList [VPMetaVar "P",VPSeqVar "P*" StarOp]] env-            rewriteTermTo (TApp "sequential" (TTuple [TApp "check-true" (TTuple [TApp "is-in-type" (TTuple [TVar "V",TApp "lists" (TTuple [TName "values"])])]),TApp "check-true" (TTuple [TApp "not" (TTuple [TApp "is-nil" (TTuple [TVar "V"])])]),TApp "map-unite" (TTuple [TApp "match-loosely" (TTuple [TApp "head" (TTuple [TVar "V"]),TVar "P"]),TApp "match-loosely" (TTuple [TApp "tail" (TTuple [TVar "V"]),TList [TVar "P*"]])])])) env-          rewrite6 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values"),VPMetaVar "P"] env-            env <- sideCondition (SCEquality (TVar "P") (TName "map-empty")) env-            rewriteTermTo (TApp "sequential" (TTuple [TApp "check-true" (TTuple [TApp "is-in-type" (TTuple [TVar "V",TApp "maps" (TTuple [TName "values",TName "values"])])]),TName "map-empty"])) env-          rewrite7 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "VM") (TName "values"),VPAnnotated (VPMetaVar "PM") (TApp "maps" (TTuple [TName "values",TName "values"]))] env-            env <- sideCondition (SCPatternMatch (TApp "some-element" (TTuple [TApp "domain" (TTuple [TVar "PM"])])) (VPMetaVar "K")) env-            rewriteTermTo (TApp "sequential" (TTuple [TApp "check-true" (TTuple [TApp "is-in-type" (TTuple [TVar "VM",TApp "maps" (TTuple [TName "values",TName "values"])])]),TApp "check-true" (TTuple [TApp "is-subset" (TTuple [TApp "domain" (TTuple [TVar "PM"]),TApp "domain" (TTuple [TVar "VM"])])]),TApp "map-unite" (TTuple [TApp "match-loosely" (TTuple [TApp "lookup" (TTuple [TVar "K",TVar "VM"]),TApp "lookup" (TTuple [TVar "K",TVar "PM"])]),TApp "match-loosely" (TTuple [TApp "map-delete" (TTuple [TVar "VM",TSet [TVar "K"]]),TApp "map-delete" (TTuple [TVar "PM",TSet [TVar "K"]])])])])) env-          rewrite8 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPMetaVar "V",VPAnnotated (VPMetaVar "P") (TApp "multisets" (TTuple [TName "values"]))] env-            rewriteTermTo (TApp "sequential" (TTuple [TApp "check-true" (TTuple [TApp "is-in-type" (TTuple [TVar "V",TApp "multisets" (TTuple [TName "values"])])]),TApp "check-true" (TTuple [TApp "is-submultiset" (TTuple [TVar "P",TVar "V"])]),TName "map-empty"])) env-          rewrite9 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPMetaVar "V",VPAnnotated (VPMetaVar "P") (TApp "sets" (TTuple [TName "values"]))] env-            rewriteTermTo (TApp "sequential" (TTuple [TApp "check-true" (TTuple [TApp "is-in-type" (TTuple [TVar "V",TApp "sets" (TTuple [TName "values"])])]),TApp "check-true" (TTuple [TApp "is-subset" (TTuple [TVar "P",TVar "V"])]),TName "map-empty"])) env-          rewrite10 = do-            let env = emptyEnv-            env <- vsMatch fargs [PTuple [VPAnnotated (VPMetaVar "V") (TName "values"),VPAnnotated (VPSeqVar "V+" PlusOp) (TName "values")],PTuple [VPAnnotated (VPMetaVar "P") (TName "values"),VPAnnotated (VPSeqVar "P+" PlusOp) (TName "values")]] env-            rewriteTermTo (TApp "map-unite" (TTuple [TApp "match-loosely" (TTuple [TVar "V",TVar "P"]),TApp "match-loosely" (TTuple [TTuple [TVar "V+"],TTuple [TVar "P+"]])])) env-          rewrite11 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values"),PTuple [VPAnnotated (VPMetaVar "P") (TName "values"),VPAnnotated (VPSeqVar "P+" PlusOp) (TName "values")]] env-            env <- sideCondition (SCNotInSort (TVar "V") (TApp "tuples" (TTuple [TName "values",TSortSeq (TName "values") PlusOp]))) env-            rewriteTo (FName "fail")-          rewrite12 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values"),VPAnnotated (VPMetaVar "P") (TApp "vectors" (TTuple [TName "patterns"]))] env-            rewriteTermTo (TApp "sequential" (TTuple [TApp "check-true" (TTuple [TApp "is-in-type" (TTuple [TVar "V",TApp "vectors" (TTuple [TName "values"])])]),TApp "check-true" (TTuple [TApp "is-greater-or-equal" (TTuple [TApp "vector-length" (TTuple [TVar "V"]),TApp "vector-length" (TTuple [TVar "P"])])]),TApp "match-loosely" (TTuple [TApp "list-prefix" (TTuple [TApp "vector-length" (TTuple [TVar "P"]),TApp "vector-to-list" (TTuple [TVar "V"])]),TApp "vector-to-list" (TTuple [TVar "P"])])])) env
− cbs/Funcons/Core/Abstractions/Patterns/PatternAny.hs 
@@ -1,23 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Abstractions/Patterns/pattern-any.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Abstractions.Patterns.PatternAny where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("pattern-any",NullaryFuncon stepPattern_any)]---- |--- /pattern-any/ is a pattern that matches any value,---   computing the empty environment.-pattern_any_ = FName "pattern-any"-stepPattern_any = evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            rewriteTo (FApp "thunk" (FTuple [FName "map-empty"]))
− cbs/Funcons/Core/Abstractions/Patterns/PatternBind.hs 
@@ -1,25 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Abstractions/Patterns/pattern-bind.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Abstractions.Patterns.PatternBind where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("pattern-bind",StrictFuncon stepPattern_bind)]---- |--- /pattern-bind(B)/ is a pattern that matches any value /V/ ,---   computing the singleton environment /{B |-> V}/ -pattern_bind_ fargs = FApp "pattern-bind" (FTuple fargs)-stepPattern_bind fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "B") (TName "values")] env-            rewriteTermTo (TApp "thunk" (TTuple [TApp "bind" (TTuple [TVar "B",TName "given"])])) env
− cbs/Funcons/Core/Abstractions/Patterns/PatternPrefer.hs 
@@ -1,26 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Abstractions/Patterns/pattern-prefer.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Abstractions.Patterns.PatternPrefer where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("pattern-prefer",StrictFuncon stepPattern_prefer)]---- |--- /pattern-prefer(P1,P2)/ is a pattern that attempts to match the value against---   /P1/ .  If this succeeds then the resulting environment is returned.---   Otherwise, the value is matched against /P2/ . -pattern_prefer_ fargs = FApp "pattern-prefer" (FTuple fargs)-stepPattern_prefer fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "P1") (TName "values"),VPAnnotated (VPMetaVar "P2") (TName "values")] env-            rewriteTermTo (TApp "thunk" (TTuple [TApp "else" (TTuple [TApp "match" (TTuple [TName "given",TVar "P1"]),TApp "match" (TTuple [TName "given",TVar "P2"])])])) env
− cbs/Funcons/Core/Abstractions/Patterns/PatternUnite.hs 
@@ -1,25 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Abstractions/Patterns/pattern-unite.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Abstractions.Patterns.PatternUnite where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("pattern-unite",StrictFuncon stepPattern_unite)]---- |--- /pattern-unite(P1,P2)/ is a pattern that requires the matched value to match---   both /P1/ and /P2/ , uniting the resulting /environments/ . -pattern_unite_ fargs = FApp "pattern-unite" (FTuple fargs)-stepPattern_unite fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "P1") (TName "values"),VPAnnotated (VPMetaVar "P2") (TName "values")] env-            rewriteTermTo (TApp "thunk" (TTuple [TApp "map-unite" (TTuple [TApp "match" (TTuple [TName "given",TVar "P1"]),TApp "match" (TTuple [TName "given",TVar "P2"])])])) env
− cbs/Funcons/Core/Abstractions/Patterns/Patterns.hs 
@@ -1,20 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Abstractions/Patterns/patterns.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Abstractions.Patterns.Patterns where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("patterns",NullaryFuncon stepPatterns)]--patterns_ = FName "patterns"-stepPatterns = evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            rewriteTo (FName "values")
+ cbs/Funcons/Core/Computations/Abnormal/Abrupting/Abrupting.hs view
@@ -0,0 +1,77 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Computations/Abnormal/Abrupting/Abrupting.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Computations.Abnormal.Abrupting.Abrupting where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    []++funcons = libFromList+    [("finalise-abrupting",NonStrictFuncon stepFinalise_abrupting),("abrupt",StrictFuncon stepAbrupt),("handle-abrupt",NonStrictFuncon stepHandle_abrupt),("finally",NonStrictFuncon stepFinally)]++finalise_abrupting_ fargs = FApp "finalise-abrupting" (fargs)+stepFinalise_abrupting fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "X"] env+            rewriteTermTo (TApp "handle-abrupt" [TVar "X",TName "none"]) env++abrupt_ fargs = FApp "abrupt" (fargs)+stepAbrupt fargs =+    evalRules [] [step1]+    where step1 = do+            let env = emptyEnv+            env <- lifted_vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "defined-values")] env+            env <- getControlPatt "abrupted" (Just (VPMetaVar "V")) env+            raiseTerm "abrupted" (TVar "V") env+            stepTermTo (TName "stuck") env++handle_abrupt_ fargs = FApp "handle-abrupt" (fargs)+stepHandle_abrupt fargs =+    evalRules [rewrite1] [step1,step2]+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PAnnotated (PMetaVar "V") (TName "values"),PMetaVar "Y"] env+            rewriteTermTo (TVar "V") env+          step1 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PMetaVar "X",PMetaVar "Y"] env+            env <- getControlPatt "abrupted" (Nothing) env+            (env,[__varabrupted]) <- receiveSignals ["abrupted"] (withControlTerm "abrupted" (Nothing) env (premise (TVar "X") (PMetaVar "X'") env))+            env <- receiveSignalPatt __varabrupted (Nothing) env+            stepTermTo (TApp "handle-abrupt" [TVar "X'",TVar "Y"]) env+          step2 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PMetaVar "X",PMetaVar "Y"] env+            env <- getControlPatt "abrupted" (Nothing) env+            (env,[__varabrupted]) <- receiveSignals ["abrupted"] (withControlTerm "abrupted" (Just (TVar "V")) env (premise (TVar "X") (PMetaVar "X'") env))+            env <- receiveSignalPatt __varabrupted (Just (VPAnnotated (VPMetaVar "V") (TName "defined-values"))) env+            stepTermTo (TApp "give" [TVar "V",TVar "Y"]) env++finally_ fargs = FApp "finally" (fargs)+stepFinally fargs =+    evalRules [rewrite1] [step1,step2]+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PAnnotated (PMetaVar "V") (TName "values"),PMetaVar "Y"] env+            rewriteTermTo (TApp "sequential" [TVar "Y",TVar "V"]) env+          step1 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PMetaVar "X",PMetaVar "Y"] env+            env <- getControlPatt "abrupted" (Nothing) env+            (env,[__varabrupted]) <- receiveSignals ["abrupted"] (withControlTerm "abrupted" (Nothing) env (premise (TVar "X") (PMetaVar "X'") env))+            env <- receiveSignalPatt __varabrupted (Nothing) env+            stepTermTo (TApp "finally" [TVar "X'",TVar "Y"]) env+          step2 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PMetaVar "X",PMetaVar "Y"] env+            env <- getControlPatt "abrupted" (Nothing) env+            (env,[__varabrupted]) <- receiveSignals ["abrupted"] (withControlTerm "abrupted" (Just (TVar "V")) env (premise (TVar "X") (PMetaVar "X'") env))+            env <- receiveSignalPatt __varabrupted (Just (VPAnnotated (VPMetaVar "V") (TName "defined-values"))) env+            stepTermTo (TApp "sequential" [TVar "Y",TApp "abrupt" [TVar "V"]]) env
+ cbs/Funcons/Core/Computations/Abnormal/Breaking/Breaking.hs view
@@ -0,0 +1,68 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Computations/Abnormal/Breaking/Breaking.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Computations.Abnormal.Breaking.Breaking where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    [("breaking",DataTypeMemberss "breaking" [] [DataTypeMemberConstructor "broken" [] (Just [])])]++funcons = libFromList+    [("broken",NullaryFuncon stepBroken),("finalise-breaking",NonStrictFuncon stepFinalise_breaking),("break",NullaryFuncon stepBreak),("handle-break",NonStrictFuncon stepHandle_break),("breaking",NullaryFuncon stepBreaking)]++broken_ = FName "broken"+stepBroken = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 'b'),FValue (Ascii 'r'),FValue (Ascii 'o'),FValue (Ascii 'k'),FValue (Ascii 'e'),FValue (Ascii 'n')]))]) env++finalise_breaking_ fargs = FApp "finalise-breaking" (fargs)+stepFinalise_breaking fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "X"] env+            rewriteTermTo (TApp "finalise-abrupting" [TVar "X"]) env++break_ = FName "break"+stepBreak = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "abrupt" [TName "broken"]) env++handle_break_ fargs = FApp "handle-break" (fargs)+stepHandle_break fargs =+    evalRules [rewrite1] [step1,step2,step3]+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PValue (PADT "none" [])] env+            rewriteTermTo (TName "none") env+          step1 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PMetaVar "X"] env+            env <- getControlPatt "abrupted" (Nothing) env+            (env,[__varabrupted]) <- receiveSignals ["abrupted"] (withControlTerm "abrupted" (Nothing) env (premise (TVar "X") (PMetaVar "X'") env))+            env <- receiveSignalPatt __varabrupted (Nothing) env+            stepTermTo (TApp "handle-break" [TVar "X'"]) env+          step2 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PMetaVar "X"] env+            env <- getControlPatt "abrupted" (Nothing) env+            (env,[__varabrupted]) <- receiveSignals ["abrupted"] (withControlTerm "abrupted" (Just (TName "broken")) env (premise (TVar "X") (PWildCard) env))+            env <- receiveSignalPatt __varabrupted (Just (PADT "broken" [])) env+            stepTermTo (TName "none") env+          step3 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PMetaVar "X"] env+            env <- getControlPatt "abrupted" (Just (VPMetaVar "V")) env+            (env,[__varabrupted]) <- receiveSignals ["abrupted"] (withControlTerm "abrupted" (Just (TVar "V")) env (premise (TVar "X") (PMetaVar "X'") env))+            env <- receiveSignalPatt __varabrupted (Just (VPAnnotated (VPMetaVar "V") (TSortComplement (TName "breaking")))) env+            raiseTerm "abrupted" (TVar "V") env+            stepTermTo (TApp "handle-break" [TVar "X'"]) env++breaking_ = FName "breaking"+stepBreaking = rewriteType "breaking" []
+ cbs/Funcons/Core/Computations/Abnormal/Continuing/Continuing.hs view
@@ -0,0 +1,68 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Computations/Abnormal/Continuing/Continuing.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Computations.Abnormal.Continuing.Continuing where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    [("continuing",DataTypeMemberss "continuing" [] [DataTypeMemberConstructor "continued" [] (Just [])])]++funcons = libFromList+    [("continued",NullaryFuncon stepContinued),("finalise-continuing",NonStrictFuncon stepFinalise_continuing),("continue",NullaryFuncon stepContinue),("handle-continue",NonStrictFuncon stepHandle_continue),("continuing",NullaryFuncon stepContinuing)]++continued_ = FName "continued"+stepContinued = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 'c'),FValue (Ascii 'o'),FValue (Ascii 'n'),FValue (Ascii 't'),FValue (Ascii 'i'),FValue (Ascii 'n'),FValue (Ascii 'u'),FValue (Ascii 'e'),FValue (Ascii 'd')]))]) env++finalise_continuing_ fargs = FApp "finalise-continuing" (fargs)+stepFinalise_continuing fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "X"] env+            rewriteTermTo (TApp "finalise-abrupting" [TVar "X"]) env++continue_ = FName "continue"+stepContinue = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "abrupt" [TName "continued"]) env++handle_continue_ fargs = FApp "handle-continue" (fargs)+stepHandle_continue fargs =+    evalRules [rewrite1] [step1,step2,step3]+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PValue (PADT "none" [])] env+            rewriteTermTo (TName "none") env+          step1 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PMetaVar "X"] env+            env <- getControlPatt "abrupted" (Nothing) env+            (env,[__varabrupted]) <- receiveSignals ["abrupted"] (withControlTerm "abrupted" (Nothing) env (premise (TVar "X") (PMetaVar "X'") env))+            env <- receiveSignalPatt __varabrupted (Nothing) env+            stepTermTo (TApp "handle-continue" [TVar "X'"]) env+          step2 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PMetaVar "X"] env+            env <- getControlPatt "abrupted" (Nothing) env+            (env,[__varabrupted]) <- receiveSignals ["abrupted"] (withControlTerm "abrupted" (Just (TName "continued")) env (premise (TVar "X") (PWildCard) env))+            env <- receiveSignalPatt __varabrupted (Just (PADT "continued" [])) env+            stepTermTo (TName "none") env+          step3 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PMetaVar "X"] env+            env <- getControlPatt "abrupted" (Just (VPMetaVar "V")) env+            (env,[__varabrupted]) <- receiveSignals ["abrupted"] (withControlTerm "abrupted" (Just (TVar "V")) env (premise (TVar "X") (PMetaVar "X'") env))+            env <- receiveSignalPatt __varabrupted (Just (VPAnnotated (VPMetaVar "V") (TSortComplement (TName "continuing")))) env+            raiseTerm "abrupted" (TVar "V") env+            stepTermTo (TApp "handle-continue" [TVar "X'"]) env++continuing_ = FName "continuing"+stepContinuing = rewriteType "continuing" []
+ cbs/Funcons/Core/Computations/Abnormal/Controlling/Controlling.hs view
@@ -0,0 +1,78 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Computations/Abnormal/Controlling/Controlling.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Computations.Abnormal.Controlling.Controlling where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    [("continuations",DataTypeMemberss "continuations" [TPVar "T1",TPVar "T2"] [DataTypeMemberConstructor "continuation" [TApp "abstractions" [TVar "T2"]] (Just [TPVar "T1",TPVar "T2"])])]++funcons = libFromList+    [("continuation",StrictFuncon stepContinuation),("hole",NullaryFuncon stepHole),("resume-continuation",StrictFuncon stepResume_continuation),("control",StrictFuncon stepControl),("delimit-continuations",NonStrictFuncon stepDelimit_continuations),("continuations",StrictFuncon stepContinuations)]++continuation_ fargs = FApp "continuation" (fargs)+stepContinuation fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPMetaVar "_X1"] env+            env <- sideCondition (SCIsInSort (TVar "_X1") (TName "values")) env+            rewriteTermTo (TApp "datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 'c'),FValue (Ascii 'o'),FValue (Ascii 'n'),FValue (Ascii 't'),FValue (Ascii 'i'),FValue (Ascii 'n'),FValue (Ascii 'u'),FValue (Ascii 'a'),FValue (Ascii 't'),FValue (Ascii 'i'),FValue (Ascii 'o'),FValue (Ascii 'n')])),TVar "_X1"]) env++hole_ = FName "hole"+stepHole = evalRules [] [step1]+    where step1 = do+            let env = emptyEnv+            env <- getControlPatt "plug-signal" (Just (VPMetaVar "V")) env+            raiseTerm "plug-signal" (TVar "V") env+            stepTermTo (TVar "V") env++resume_continuation_ fargs = FApp "resume-continuation" (fargs)+stepResume_continuation fargs =+    evalRules [] [step1]+    where step1 = do+            let env = emptyEnv+            env <- lifted_vsMatch fargs [PADT "continuation" [PADT "abstraction" [VPMetaVar "X"]],VPAnnotated (VPMetaVar "V") (TName "values")] env+            env <- getControlPatt "plug-signal" (Nothing) env+            (env,[__varplug_signal]) <- receiveSignals ["plug-signal"] (withControlTerm "plug-signal" (Just (TVar "V")) env (premise (TVar "X") (PMetaVar "X'") env))+            env <- receiveSignalPatt __varplug_signal (Just (VPMetaVar "V")) env+            stepTermTo (TVar "X'") env++control_ fargs = FApp "control" (fargs)+stepControl fargs =+    evalRules [] [step1]+    where step1 = do+            let env = emptyEnv+            env <- lifted_vsMatch fargs [VPAnnotated (VPMetaVar "F") (TApp "functions" [TApp "continuations" [TName "values",TName "values"],TName "values"])] env+            env <- getControlPatt "control-signal" (Just (VPMetaVar "F")) env+            raiseTerm "control-signal" (TVar "F") env+            stepTermTo (TName "hole") env++delimit_continuations_ fargs = FApp "delimit-continuations" (fargs)+stepDelimit_continuations fargs =+    evalRules [rewrite1] [step1,step2]+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PAnnotated (PMetaVar "V") (TName "values")] env+            rewriteTermTo (TVar "V") env+          step1 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PMetaVar "E"] env+            env <- getControlPatt "control-signal" (Nothing) env+            (env,[__varcontrol_signal]) <- receiveSignals ["control-signal"] (withControlTerm "control-signal" (Nothing) env (premise (TVar "E") (PMetaVar "E'") env))+            env <- receiveSignalPatt __varcontrol_signal (Nothing) env+            stepTermTo (TApp "delimit-continuations" [TVar "E'"]) env+          step2 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PMetaVar "E"] env+            env <- getControlPatt "control-signal" (Nothing) env+            (env,[__varcontrol_signal]) <- receiveSignals ["control-signal"] (withControlTerm "control-signal" (Just (TVar "F")) env (premise (TVar "E") (PMetaVar "E'") env))+            env <- receiveSignalPatt __varcontrol_signal (Just (VPMetaVar "F")) env+            stepTermTo (TApp "delimit-continuations" [TApp "apply" [TVar "F",TApp "continuation" [TApp "closure" [TVar "E'"]]]]) env++continuations_ = FApp "continuations"+stepContinuations ts = rewriteType "continuations" ts
+ cbs/Funcons/Core/Computations/Abnormal/Failing/Failing.hs view
@@ -0,0 +1,110 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Computations/Abnormal/Failing/Failing.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Computations.Abnormal.Failing.Failing where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    [("failing",DataTypeMemberss "failing" [] [DataTypeMemberConstructor "failed" [] (Just [])])]++funcons = libFromList+    [("failed",NullaryFuncon stepFailed),("finalise-failing",NonStrictFuncon stepFinalise_failing),("fail",NullaryFuncon stepFail),("else",NonStrictFuncon stepElse),("else-choice",NonStrictFuncon stepElse_choice),("check-true",StrictFuncon stepCheck_true),("check",StrictFuncon stepCheck_true),("defined",StrictFuncon stepDefined),("def",StrictFuncon stepDefined),("failing",NullaryFuncon stepFailing)]++failed_ = FName "failed"+stepFailed = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 'f'),FValue (Ascii 'a'),FValue (Ascii 'i'),FValue (Ascii 'l'),FValue (Ascii 'e'),FValue (Ascii 'd')]))]) env++finalise_failing_ fargs = FApp "finalise-failing" (fargs)+stepFinalise_failing fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "X"] env+            rewriteTermTo (TApp "finalise-abrupting" [TVar "X"]) env++fail_ = FName "fail"+stepFail = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "abrupt" [TName "failed"]) env++else_ fargs = FApp "else" (fargs)+stepElse fargs =+    evalRules [rewrite1,rewrite2] [step1,step2,step3]+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PAnnotated (PMetaVar "V") (TName "values"),PMetaVar "Y"] env+            rewriteTermTo (TVar "V") env+          rewrite2 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "X",PMetaVar "Y",PSeqVar "Z+" PlusOp] env+            rewriteTermTo (TApp "else" [TVar "X",TApp "else" [TVar "Y",TVar "Z+"]]) env+          step1 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PMetaVar "X",PMetaVar "Y"] env+            env <- getControlPatt "abrupted" (Nothing) env+            (env,[__varabrupted]) <- receiveSignals ["abrupted"] (withControlTerm "abrupted" (Nothing) env (premise (TVar "X") (PMetaVar "X'") env))+            env <- receiveSignalPatt __varabrupted (Nothing) env+            stepTermTo (TApp "else" [TVar "X'",TVar "Y"]) env+          step2 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PMetaVar "X",PMetaVar "Y"] env+            env <- getControlPatt "abrupted" (Nothing) env+            (env,[__varabrupted]) <- receiveSignals ["abrupted"] (withControlTerm "abrupted" (Just (TName "failed")) env (premise (TVar "X") (PWildCard) env))+            env <- receiveSignalPatt __varabrupted (Just (PADT "failed" [])) env+            stepTermTo (TVar "Y") env+          step3 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PMetaVar "X",PMetaVar "Y"] env+            env <- getControlPatt "abrupted" (Just (VPMetaVar "V")) env+            (env,[__varabrupted]) <- receiveSignals ["abrupted"] (withControlTerm "abrupted" (Just (TVar "V")) env (premise (TVar "X") (PMetaVar "X'") env))+            env <- receiveSignalPatt __varabrupted (Just (VPAnnotated (VPMetaVar "V") (TSortComplement (TName "failing")))) env+            raiseTerm "abrupted" (TVar "V") env+            stepTermTo (TApp "else" [TVar "X'",TVar "Y"]) env++else_choice_ fargs = FApp "else-choice" (fargs)+stepElse_choice fargs =+    evalRules [rewrite1,rewrite2] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PSeqVar "W*" StarOp,PMetaVar "X",PMetaVar "Y",PSeqVar "Z*" StarOp] env+            rewriteTermTo (TApp "choice" [TApp "else" [TVar "X",TApp "else-choice" [TVar "W*",TVar "Y",TVar "Z*"],TApp "else" [TVar "Y",TApp "else-choice" [TVar "W*",TVar "X",TVar "Z*"]]]]) env+          rewrite2 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "X"] env+            rewriteTermTo (TVar "X") env++check_true_ fargs = FApp "check-true" (fargs)+check_ fargs = FApp "check-true" (fargs)+stepCheck_true fargs =+    evalRules [rewrite1,rewrite2] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "true" []] env+            rewriteTermTo (TName "none") env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "false" []] env+            rewriteTermTo (TName "fail") env++defined_ fargs = FApp "defined" (fargs)+def_ fargs = FApp "defined" (fargs)+stepDefined fargs =+    evalRules [rewrite1,rewrite2] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "defined-values")] env+            rewriteTermTo (TVar "V") env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "none" []] env+            rewriteTermTo (TName "fail") env++failing_ = FName "failing"+stepFailing = rewriteType "failing" []
+ cbs/Funcons/Core/Computations/Abnormal/Returning/Returning.hs view
@@ -0,0 +1,73 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Computations/Abnormal/Returning/Returning.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Computations.Abnormal.Returning.Returning where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    [("returning",DataTypeMemberss "returning" [] [DataTypeMemberConstructor "returned" [TName "defined-values"] (Just [])])]++funcons = libFromList+    [("returned",StrictFuncon stepReturned),("finalise-returning",NonStrictFuncon stepFinalise_returning),("return",StrictFuncon stepReturn),("handle-return",NonStrictFuncon stepHandle_return),("returning",NullaryFuncon stepReturning)]++returned_ fargs = FApp "returned" (fargs)+stepReturned fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPMetaVar "_X1"] env+            env <- sideCondition (SCIsInSort (TVar "_X1") (TName "values")) env+            rewriteTermTo (TApp "datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 'r'),FValue (Ascii 'e'),FValue (Ascii 't'),FValue (Ascii 'u'),FValue (Ascii 'r'),FValue (Ascii 'n'),FValue (Ascii 'e'),FValue (Ascii 'd')])),TVar "_X1"]) env++finalise_returning_ fargs = FApp "finalise-returning" (fargs)+stepFinalise_returning fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "X"] env+            rewriteTermTo (TApp "finalise-abrupting" [TVar "X"]) env++return_ fargs = FApp "return" (fargs)+stepReturn fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values")] env+            rewriteTermTo (TApp "abrupt" [TApp "returned" [TVar "V"]]) env++handle_return_ fargs = FApp "handle-return" (fargs)+stepHandle_return fargs =+    evalRules [rewrite1] [step1,step2,step3]+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PAnnotated (PMetaVar "V") (TName "values")] env+            rewriteTermTo (TVar "V") env+          step1 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PMetaVar "X"] env+            env <- getControlPatt "abrupted" (Nothing) env+            (env,[__varabrupted]) <- receiveSignals ["abrupted"] (withControlTerm "abrupted" (Nothing) env (premise (TVar "X") (PMetaVar "X'") env))+            env <- receiveSignalPatt __varabrupted (Nothing) env+            stepTermTo (TApp "handle-return" [TVar "X'"]) env+          step2 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PMetaVar "X"] env+            env <- getControlPatt "abrupted" (Nothing) env+            (env,[__varabrupted]) <- receiveSignals ["abrupted"] (withControlTerm "abrupted" (Just (TApp "returned" [TVar "V"])) env (premise (TVar "X") (PMetaVar "X'") env))+            env <- receiveSignalPatt __varabrupted (Just (PADT "returned" [VPAnnotated (VPMetaVar "V") (TName "defined-values")])) env+            stepTermTo (TVar "V") env+          step3 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PMetaVar "X"] env+            env <- getControlPatt "abrupted" (Just (VPMetaVar "V'")) env+            (env,[__varabrupted]) <- receiveSignals ["abrupted"] (withControlTerm "abrupted" (Just (TVar "V'")) env (premise (TVar "X") (PMetaVar "X'") env))+            env <- receiveSignalPatt __varabrupted (Just (VPAnnotated (VPMetaVar "V'") (TSortComplement (TName "returning")))) env+            raiseTerm "abrupted" (TVar "V'") env+            stepTermTo (TApp "handle-return" [TVar "X'"]) env++returning_ = FName "returning"+stepReturning = rewriteType "returning" []
+ cbs/Funcons/Core/Computations/Abnormal/Sticking.hs view
@@ -0,0 +1,16 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Computations/Abnormal/Sticking.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Computations.Abnormal.Sticking where++import Funcons.EDSL+entities = []++types = typeEnvFromList+    []++funcons = libFromList+    [("stuck",NullaryFuncon stepStuck)]++stuck_ = FName "stuck"+stepStuck = norule (FName "stuck")
+ cbs/Funcons/Core/Computations/Abnormal/Throwing/Throwing.hs view
@@ -0,0 +1,89 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Computations/Abnormal/Throwing/Throwing.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Computations.Abnormal.Throwing.Throwing where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    [("throwing",DataTypeMemberss "throwing" [] [DataTypeMemberConstructor "thrown" [TName "defined-values"] (Just [])])]++funcons = libFromList+    [("thrown",StrictFuncon stepThrown),("finalise-throwing",NonStrictFuncon stepFinalise_throwing),("throw",StrictFuncon stepThrow),("handle-thrown",NonStrictFuncon stepHandle_thrown),("handle-recursively",NonStrictFuncon stepHandle_recursively),("catch-else-throw",PartiallyStrictFuncon [Strict,NonStrict] NonStrict stepCatch_else_throw),("throwing",NullaryFuncon stepThrowing)]++thrown_ fargs = FApp "thrown" (fargs)+stepThrown fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPMetaVar "_X1"] env+            env <- sideCondition (SCIsInSort (TVar "_X1") (TName "values")) env+            rewriteTermTo (TApp "datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 't'),FValue (Ascii 'h'),FValue (Ascii 'r'),FValue (Ascii 'o'),FValue (Ascii 'w'),FValue (Ascii 'n')])),TVar "_X1"]) env++finalise_throwing_ fargs = FApp "finalise-throwing" (fargs)+stepFinalise_throwing fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "X"] env+            rewriteTermTo (TApp "finalise-abrupting" [TVar "X"]) env++throw_ fargs = FApp "throw" (fargs)+stepThrow fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "defined-values")] env+            rewriteTermTo (TApp "abrupt" [TApp "thrown" [TVar "V"]]) env++handle_thrown_ fargs = FApp "handle-thrown" (fargs)+stepHandle_thrown fargs =+    evalRules [rewrite1] [step1,step2,step3]+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PAnnotated (PMetaVar "V") (TName "values"),PMetaVar "Y"] env+            rewriteTermTo (TVar "V") env+          step1 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PMetaVar "X",PMetaVar "Y"] env+            env <- getControlPatt "abrupted" (Nothing) env+            (env,[__varabrupted]) <- receiveSignals ["abrupted"] (withControlTerm "abrupted" (Nothing) env (premise (TVar "X") (PMetaVar "X'") env))+            env <- receiveSignalPatt __varabrupted (Nothing) env+            stepTermTo (TApp "handle-thrown" [TVar "X'",TVar "Y"]) env+          step2 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PMetaVar "X",PMetaVar "Y"] env+            env <- getControlPatt "abrupted" (Nothing) env+            (env,[__varabrupted]) <- receiveSignals ["abrupted"] (withControlTerm "abrupted" (Just (TApp "thrown" [TVar "V"])) env (premise (TVar "X") (PMetaVar "X'") env))+            env <- receiveSignalPatt __varabrupted (Just (PADT "thrown" [VPAnnotated (VPMetaVar "V") (TName "defined-values")])) env+            stepTermTo (TApp "give" [TVar "V",TVar "Y"]) env+          step3 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PMetaVar "X",PMetaVar "Y"] env+            env <- getControlPatt "abrupted" (Just (VPMetaVar "V'")) env+            (env,[__varabrupted]) <- receiveSignals ["abrupted"] (withControlTerm "abrupted" (Just (TVar "V'")) env (premise (TVar "X") (PMetaVar "X'") env))+            env <- receiveSignalPatt __varabrupted (Just (VPAnnotated (VPMetaVar "V'") (TSortComplement (TName "throwing")))) env+            raiseTerm "abrupted" (TVar "V'") env+            stepTermTo (TApp "handle-thrown" [TVar "X'",TVar "Y"]) env++handle_recursively_ fargs = FApp "handle-recursively" (fargs)+stepHandle_recursively fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "X",PMetaVar "Y"] env+            rewriteTermTo (TApp "handle-thrown" [TVar "X",TApp "else" [TApp "handle-recursively" [TVar "Y",TVar "Y"],TApp "throw" [TName "given"]]]) env++catch_else_throw_ fargs = FApp "catch-else-throw" (fargs)+stepCatch_else_throw fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PAnnotated (PMetaVar "P") (TName "defined-values"),PMetaVar "Y"] env+            rewriteTermTo (TApp "else" [TApp "case-match" [TVar "P",TVar "Y"],TApp "throw" [TName "given"]]) env++throwing_ = FName "throwing"+stepThrowing = rewriteType "throwing" []
− cbs/Funcons/Core/Computations/ControlFlow/Abnormal/Continuations/Abort.hs 
@@ -1,26 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Abnormal/Continuations/abort.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Abort where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("abort",StrictFuncon stepAbort)]---- |--- /abort(V)/ emits a /control-signal/ that, when handled by an enclosing---   /prompt/ , aborts the current computation up to that enclosing /prompt/ ,---   returning the value /V/ .-abort_ fargs = FApp "abort" (FTuple fargs)-stepAbort fargs =-    evalRules [] [step1]-    where step1 = do-            let env = emptyEnv-            env <- lifted_vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values")] env-            stepTermTo (TApp "control" (TTuple [TApp "lambda" (TTuple [TVar "V"])])) env
− cbs/Funcons/Core/Computations/ControlFlow/Abnormal/Continuations/CallCc.hs 
@@ -1,28 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Abnormal/Continuations/call-cc.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.CallCc where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("call-cc",StrictFuncon stepCall_cc)]---- |--- /call-cc(F)/ emits a /control-signal/ that, when handled by an enclosing---   /prompt/ , applies /F/ to the current continuation.  If that current---   continuation argument is invoked, then the current computation will terminate---   up to the enclosing /prompt/ when that continuation terminates.-call_cc_ fargs = FApp "call-cc" (FTuple fargs)-stepCall_cc fargs =-    evalRules [] [step1]-    where step1 = do-            let env = emptyEnv-            env <- lifted_vsMatch fargs [VPAnnotated (VPMetaVar "F") (TName "values")] env-            env <- premise (TName "fresh-binder") (PMetaVar "K") env-            stepTermTo (TApp "control" (TTuple [TApp "binding-lambda" (TTuple [TVar "K",TApp "apply" (TTuple [TApp "bound" (TTuple [TVar "K"]),TApp "apply" (TTuple [TVar "F",TApp "lambda" (TTuple [TApp "abort" (TTuple [TApp "apply" (TTuple [TApp "bound" (TTuple [TVar "K"]),TName "given"])])])])])])])) env
− cbs/Funcons/Core/Computations/ControlFlow/Abnormal/Continuations/Control.hs 
@@ -1,27 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Abnormal/Continuations/control.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Control where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("control",StrictFuncon stepControl)]---- |--- /control(F)/ emits a /control-signal/ that, when handled by an enclosing---   /prompt/ , will cause /F/ to the current continuation of /control(F)/ ,---    instead of continuing the current computation.-control_ fargs = FApp "control" (FTuple fargs)-stepControl fargs =-    evalRules [] [step1]-    where step1 = do-            let env = emptyEnv-            env <- lifted_vsMatch fargs [VPAnnotated (VPMetaVar "F") (TName "values")] env-            raiseTerm "control-signal" (TTuple [TVar "F"]) env-            stepTo (FName "hole")
− cbs/Funcons/Core/Computations/ControlFlow/Abnormal/Continuations/ControlSignal.hs 
@@ -1,14 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Abnormal/Continuations/control-signal.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.ControlSignal where--import Funcons.EDSL--entities = [DefControl "control-signal"]--types = typeEnvFromList-    []--funcons = libFromList-    []
− cbs/Funcons/Core/Computations/ControlFlow/Abnormal/Continuations/Hole.hs 
@@ -1,23 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Abnormal/Continuations/hole.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Hole where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("hole",NullaryFuncon stepHole)]---- |--- A /hole/ in a term cannot proceed until it receives a /resume-signal/ containing a value to fill the hole.-hole_ = FName "hole"-stepHole = evalRules [] [step1]-    where step1 = do-            let env = emptyEnv-            env <- assignInput "resume-signal" "V" env-            stepTermTo (TVar "V") env
− cbs/Funcons/Core/Computations/ControlFlow/Abnormal/Continuations/Plug.hs 
@@ -1,27 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Abnormal/Continuations/plug.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Plug where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("plug",PartiallyStrictFuncon [NonStrict,Strict] stepPlug)]---- |--- /plug(E,V)/ plugs the value /V/ into a /hole/ that occurs as a subterm---   within the computation /E/ , provided the /hole/ is in an evaluable position.-plug_ fargs = FApp "plug" (FTuple fargs)-stepPlug fargs@[arg1,arg2] =-    evalRules [] [step1]-    where step1 = do-            let env = emptyEnv-            env <- lifted_fsMatch fargs [PMetaVar "E",PAnnotated (PMetaVar "V") (TName "values")] env-            env <- withExactInputTerms "resume-signal" [TVar "V"] env (premise (TVar "E") (PMetaVar "E'") env)-            stepTermTo (TVar "E'") env-stepPlug fargs = sortErr (FApp "plug" (FTuple fargs)) "invalid number of arguments"
− cbs/Funcons/Core/Computations/ControlFlow/Abnormal/Continuations/Prompt.hs 
@@ -1,35 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Abnormal/Continuations/prompt.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Prompt where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("prompt",NonStrictFuncon stepPrompt)]---- |--- /prompt/ is a delimiter for the /control/ and /call-cc/ operators.-prompt_ fargs = FApp "prompt" (FTuple fargs)-stepPrompt fargs =-    evalRules [rewrite1] [step1,step2]-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PAnnotated (PMetaVar "V") (TName "values")] env-            rewriteTermTo (TVar "V") env-          step1 = do-            let env = emptyEnv-            env <- lifted_fsMatch fargs [PMetaVar "E"] env-            env <- receiveSignalPatt "control-signal" (Nothing) (premise (TVar "E") (PMetaVar "E'") env)-            stepTermTo (TApp "prompt" (TTuple [TVar "E'"])) env-          step2 = do-            let env = emptyEnv-            env <- lifted_fsMatch fargs [PMetaVar "E"] env-            env <- receiveSignalPatt "control-signal" (Just (VPMetaVar "F")) (premise (TVar "E") (PMetaVar "E'") env)-            env <- lifted_sideCondition (SCPatternMatch (TApp "lambda" (TTuple [TApp "plug" (TTuple [TVar "E'",TName "given"])])) (VPMetaVar "K")) env-            stepTermTo (TApp "prompt" (TTuple [TApp "apply" (TTuple [TVar "F",TVar "K"])])) env
− cbs/Funcons/Core/Computations/ControlFlow/Abnormal/Continuations/Reset.hs 
@@ -1,27 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Abnormal/Continuations/reset.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Reset where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("reset",NonStrictFuncon stepReset)]---- |--- /reset/ is a delimiter for the /shift/ operator.---   A consequence of our choice of definition of /shift/ is that the semantics of---   /reset/ conincide exactly with those of /prompt/ , and thus the two can be---   used interchangeably.-reset_ fargs = FApp "reset" (FTuple fargs)-stepReset fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PMetaVar "E"] env-            rewriteTermTo (TApp "prompt" (TTuple [TVar "E"])) env
− cbs/Funcons/Core/Computations/ControlFlow/Abnormal/Continuations/ResumeSignal.hs 
@@ -1,14 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Abnormal/Continuations/resume-signal.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.ResumeSignal where--import Funcons.EDSL--entities = [DefInput "resume-signal"]--types = typeEnvFromList-    []--funcons = libFromList-    []
− cbs/Funcons/Core/Computations/ControlFlow/Abnormal/Continuations/Shift.hs 
@@ -1,28 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Abnormal/Continuations/shift.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Shift where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("shift",StrictFuncon stepShift)]---- |--- /shift(F)/ emits a /control-signal/ that, when handled by an enclosing---   /reset/ , will cause /F/ to the current continuation of /shift(F)/ ,---   Unlike /control/ , any application of the captured continuation delimits---   any control operators in its body.-shift_ fargs = FApp "shift" (FTuple fargs)-stepShift fargs =-    evalRules [] [step1]-    where step1 = do-            let env = emptyEnv-            env <- lifted_vsMatch fargs [VPAnnotated (VPMetaVar "F") (TName "values")] env-            env <- premise (TName "fresh-binder") (PMetaVar "K") env-            stepTermTo (TApp "control" (TTuple [TApp "binding-lambda" (TTuple [TVar "K",TApp "apply" (TTuple [TVar "F",TApp "lambda" (TTuple [TApp "reset" (TTuple [TApp "apply" (TTuple [TApp "bound" (TTuple [TVar "K"]),TName "given"])])])])])])) env
− cbs/Funcons/Core/Computations/ControlFlow/Abnormal/Failing/CheckTrue.hs 
@@ -1,28 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Abnormal/Failing/check-true.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Abnormal.Failing.CheckTrue where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("check-true",StrictFuncon stepCheck_true)]---- |--- /check-true(B)/ fails if /B/ is /false/ .-check_true_ fargs = FApp "check-true" (FTuple fargs)-stepCheck_true fargs =-    evalRules [rewrite1,rewrite2] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [PADT "true" []] env-            rewriteTo (FTuple [])-          rewrite2 = do-            let env = emptyEnv-            env <- vsMatch fargs [PADT "false" []] env-            rewriteTo (FName "fail")
− cbs/Funcons/Core/Computations/ControlFlow/Abnormal/Failing/Dereference.hs 
@@ -1,29 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Abnormal/Failing/dereference.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Dereference where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("dereference",StrictFuncon stepDereference)]---- |--- /dereference(P)/ fails if the pointer /P/ is /null/ , otherwise it returns---   the value referenced by /P/ .-dereference_ fargs = FApp "dereference" (FTuple fargs)-stepDereference fargs =-    evalRules [rewrite1,rewrite2] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [PADT "reference" [VPMetaVar "V"]] env-            rewriteTermTo (TVar "V") env-          rewrite2 = do-            let env = emptyEnv-            env <- vsMatch fargs [PADT "null" []] env-            rewriteTo (FName "fail")
− cbs/Funcons/Core/Computations/ControlFlow/Abnormal/Failing/Else.hs 
@@ -1,40 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Abnormal/Failing/else.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Else where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("else",NonStrictFuncon stepElse)]---- |--- /else(X1,X2,...,XN)/ evaluates each computation /X/ in turn, until one does---   *not*fail, returning the result of the successful computation.-else_ fargs = FApp "else" (FTuple fargs)-stepElse fargs =-    evalRules [rewrite1] [step1,step2,step3]-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PAnnotated (PMetaVar "V") (TName "values"),PSeqVar "Y+" PlusOp] env-            rewriteTermTo (TVar "V") env-          step1 = do-            let env = emptyEnv-            env <- lifted_fsMatch fargs [PMetaVar "X",PSeqVar "Y+" PlusOp] env-            env <- receiveSignalPatt "failed" (Nothing) (premise (TVar "X") (PMetaVar "X'") env)-            stepTermTo (TApp "else" (TTuple [TVar "X'",TVar "Y+"])) env-          step2 = do-            let env = emptyEnv-            env <- lifted_fsMatch fargs [PMetaVar "X",PMetaVar "Y"] env-            env <- receiveSignalPatt "failed" (Just (PADT "signal" [])) (premise (TVar "X") (PWildCard) env)-            stepTermTo (TVar "Y") env-          step3 = do-            let env = emptyEnv-            env <- lifted_fsMatch fargs [PMetaVar "X",PMetaVar "Y",PSeqVar "Z+" PlusOp] env-            env <- receiveSignalPatt "failed" (Just (PADT "signal" [])) (premise (TVar "X") (PWildCard) env)-            stepTermTo (TApp "else" (TTuple [TVar "Y",TVar "Z+"])) env
− cbs/Funcons/Core/Computations/ControlFlow/Abnormal/Failing/Fail.hs 
@@ -1,23 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Abnormal/Failing/fail.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Fail where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("fail",NullaryFuncon stepFail)]---- |--- /fail/ terminates abruptly.-fail_ = FName "fail"-stepFail = evalRules [] [step1]-    where step1 = do-            let env = emptyEnv-            raiseTerm "failed" (TTuple [TName "signal"]) env-            stepTo (FName "stuck")
− cbs/Funcons/Core/Computations/ControlFlow/Abnormal/Failing/Failed.hs 
@@ -1,14 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Abnormal/Failing/failed.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Failed where--import Funcons.EDSL--entities = [DefControl "failed"]--types = typeEnvFromList-    []--funcons = libFromList-    []
− cbs/Funcons/Core/Computations/ControlFlow/Abnormal/Failing/Signals.hs 
@@ -1,18 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Abnormal/Failing/signals.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Signals where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    [("signals",DataTypeMembers [] [DataTypeConstructor "signal" (TTuple [])])]--funcons = libFromList-    [("signals",NullaryFuncon stepSignals),("signal",NullaryFuncon stepSignal)]--stepSignal = rewritten (ADTVal "signal" [])--stepSignals = rewriteType "signals" []
− cbs/Funcons/Core/Computations/ControlFlow/Abnormal/Stuck.hs 
@@ -1,19 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Abnormal/stuck.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Abnormal.Stuck where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("stuck",NullaryFuncon stepStuck)]---- |--- /stuck/ cannot be evaluated.-stuck_ = FName "stuck"-stepStuck = norule (FName "stuck")
− cbs/Funcons/Core/Computations/ControlFlow/Abnormal/Throwing/Finally.hs 
@@ -1,37 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Abnormal/Throwing/finally.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.Finally where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("finally",NonStrictFuncon stepFinally)]---- |--- /finally(C,F)/ first executes /C/ .---   If /C/ terminates normally, then /F/ executes. ---   If /C/ abruptly terminates with a thrown value /V/ , then /F/ executes,---   and then /V/ is rethrown.-finally_ fargs = FApp "finally" (FTuple fargs)-stepFinally fargs =-    evalRules [rewrite1] [step1,step2]-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PValue (PTuple []),PMetaVar "F"] env-            rewriteTermTo (TVar "F") env-          step1 = do-            let env = emptyEnv-            env <- lifted_fsMatch fargs [PMetaVar "C",PMetaVar "F"] env-            env <- receiveSignalPatt "thrown" (Nothing) (premise (TVar "C") (PMetaVar "C'") env)-            stepTermTo (TApp "finally" (TTuple [TVar "C'",TVar "F"])) env-          step2 = do-            let env = emptyEnv-            env <- lifted_fsMatch fargs [PMetaVar "C",PMetaVar "F"] env-            env <- receiveSignalPatt "thrown" (Just (VPAnnotated (VPMetaVar "V") (TName "values"))) (premise (TVar "C") (PWildCard) env)-            stepTermTo (TApp "sequential" (TTuple [TVar "F",TApp "throw" (TTuple [TVar "V"])])) env
− cbs/Funcons/Core/Computations/ControlFlow/Abnormal/Throwing/HandleRecursively.hs 
@@ -1,26 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Abnormal/Throwing/handle-recursively.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.HandleRecursively where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("handle-recursively",NonStrictFuncon stepHandle_recursively)]---- |--- /handle-recursively/ behaves similarly to /handle-thrown/ , except that---   another copy of the handler attempts to handle any values thrown by the---   handler.  Thus, many thrown values may get caught by the same handler. -handle_recursively_ fargs = FApp "handle-recursively" (FTuple fargs)-stepHandle_recursively fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PMetaVar "E",PMetaVar "H"] env-            rewriteTermTo (TApp "handle-thrown" (TTuple [TVar "E",TApp "handle-recursively" (TTuple [TVar "H",TVar "H"])])) env
− cbs/Funcons/Core/Computations/ControlFlow/Abnormal/Throwing/HandleThrown.hs 
@@ -1,38 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Abnormal/Throwing/handle-thrown.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.HandleThrown where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("handle-thrown",NonStrictFuncon stepHandle_thrown)]---- |--- /handle-thrown(E,H)/ evaluates /E/ .---   If /E/ terminates normally with value /V/ ,---   then /V/ is returned and /H/ is ignored.---   If /E/ terminates abruptly with value /V/ ,---   then /H/ is executed with /given-value/ /V/ .-handle_thrown_ fargs = FApp "handle-thrown" (FTuple fargs)-stepHandle_thrown fargs =-    evalRules [rewrite1] [step1,step2]-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PAnnotated (PMetaVar "V") (TName "values"),PWildCard] env-            rewriteTermTo (TVar "V") env-          step1 = do-            let env = emptyEnv-            env <- lifted_fsMatch fargs [PMetaVar "E",PMetaVar "H"] env-            env <- receiveSignalPatt "thrown" (Nothing) (premise (TVar "E") (PMetaVar "E'") env)-            stepTermTo (TApp "handle-thrown" (TTuple [TVar "E'",TVar "H"])) env-          step2 = do-            let env = emptyEnv-            env <- lifted_fsMatch fargs [PMetaVar "E",PMetaVar "H"] env-            env <- receiveSignalPatt "thrown" (Just (VPMetaVar "V")) (premise (TVar "E") (PWildCard) env)-            stepTermTo (TApp "else" (TTuple [TApp "give" (TTuple [TVar "V",TVar "H"]),TApp "throw" (TTuple [TVar "V"])])) env
− cbs/Funcons/Core/Computations/ControlFlow/Abnormal/Throwing/Throw.hs 
@@ -1,25 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Abnormal/Throwing/throw.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.Throw where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("throw",StrictFuncon stepThrow)]---- |--- /throw(V)/ terminates abruptly with value /V/ .-throw_ fargs = FApp "throw" (FTuple fargs)-stepThrow fargs =-    evalRules [] [step1]-    where step1 = do-            let env = emptyEnv-            env <- lifted_vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values")] env-            raiseTerm "thrown" (TTuple [TVar "V"]) env-            stepTo (FName "stuck")
− cbs/Funcons/Core/Computations/ControlFlow/Abnormal/Throwing/Thrown.hs 
@@ -1,14 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Abnormal/Throwing/thrown.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.Thrown where--import Funcons.EDSL--entities = [DefControl "thrown"]--types = typeEnvFromList-    []--funcons = libFromList-    []
− cbs/Funcons/Core/Computations/ControlFlow/Normal/Choosing/IfThenElse.hs 
@@ -1,31 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Normal/Choosing/if-then-else.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Normal.Choosing.IfThenElse where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("if-then-else",PartiallyStrictFuncon [Strict,NonStrict,NonStrict] stepIf_then_else)]---- |--- /if-then-else(B,X,Y)/ first evaluates /B/ .---   Depending on whether the computed value is /true/ or /false/ ,---   it then evaluates /X/ or /Y/ .-if_then_else_ fargs = FApp "if-then-else" (FTuple fargs)-stepIf_then_else fargs@[arg1,arg2,arg3] =-    evalRules [rewrite1,rewrite2] []-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PValue (PADT "true" []),PMetaVar "X",PWildCard] env-            rewriteTermTo (TVar "X") env-          rewrite2 = do-            let env = emptyEnv-            env <- fsMatch fargs [PValue (PADT "false" []),PWildCard,PMetaVar "Y"] env-            rewriteTermTo (TVar "Y") env-stepIf_then_else fargs = sortErr (FApp "if-then-else" (FTuple fargs)) "invalid number of arguments"
− cbs/Funcons/Core/Computations/ControlFlow/Normal/Iterating/Definite/FilteringCollections/ListFilter.hs 
@@ -1,30 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Normal/Iterating/Definite/Filtering collections/list-filter.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.ListFilter where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("list-filter",PartiallyStrictFuncon [NonStrict,Strict] stepList_filter)]---- |--- /list-filter(P,L)/ discards all elements from the list /L/ that do not---   satisify the predicate /P/ .-list_filter_ fargs = FApp "list-filter" (FTuple fargs)-stepList_filter fargs@[arg1,arg2] =-    evalRules [rewrite1,rewrite2] []-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PMetaVar "P",PValue (PList [])] env-            rewriteTo (FList [])-          rewrite2 = do-            let env = emptyEnv-            env <- fsMatch fargs [PMetaVar "P",PValue (PList [VPMetaVar "V",VPSeqVar "V*" StarOp])] env-            rewriteTermTo (TApp "if-then-else" (TTuple [TApp "give" (TTuple [TVar "V",TVar "P"]),TApp "cons" (TTuple [TVar "V",TApp "list-filter" (TTuple [TVar "P",TList [TVar "V*"]])]),TApp "list-filter" (TTuple [TVar "P",TList [TVar "V*"]])])) env-stepList_filter fargs = sortErr (FApp "list-filter" (FTuple fargs)) "invalid number of arguments"
− cbs/Funcons/Core/Computations/ControlFlow/Normal/Iterating/Definite/FilteringCollections/MapFilter.hs 
@@ -1,26 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Normal/Iterating/Definite/Filtering collections/map-filter.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.MapFilter where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("map-filter",PartiallyStrictFuncon [NonStrict,Strict] stepMap_filter)]---- |--- /map-filter(P,M)/ discards all entries from the map /M/ that do not---   satisify the predicate /P/ .  /P/ is given a key/value pair.-map_filter_ fargs = FApp "map-filter" (FTuple fargs)-stepMap_filter fargs@[arg1,arg2] =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PMetaVar "F",PAnnotated (PMetaVar "M") (TName "values")] env-            rewriteTermTo (TApp "list-to-map" (TTuple [TApp "list-filter" (TTuple [TVar "F",TApp "map-to-list" (TTuple [TVar "M"])])])) env-stepMap_filter fargs = sortErr (FApp "map-filter" (FTuple fargs)) "invalid number of arguments"
− cbs/Funcons/Core/Computations/ControlFlow/Normal/Iterating/Definite/FilteringCollections/MultisetFilter.hs 
@@ -1,26 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Normal/Iterating/Definite/Filtering collections/multiset-filter.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.MultisetFilter where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("multiset-filter",PartiallyStrictFuncon [NonStrict,Strict] stepMultiset_filter)]---- |--- /multiset-filter(P,MS)/ deletes all values from the the multiset /MS/ that do---   not satisfy the predicate /P/ .  /P/ is given a /values/ //naturals/ pair.-multiset_filter_ fargs = FApp "multiset-filter" (FTuple fargs)-stepMultiset_filter fargs@[arg1,arg2] =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PMetaVar "F",PAnnotated (PMetaVar "MS") (TName "values")] env-            rewriteTermTo (TApp "list-to-multiset" (TTuple [TApp "list-filter" (TTuple [TVar "F",TApp "multiset-to-list" (TTuple [TVar "MS"])])])) env-stepMultiset_filter fargs = sortErr (FApp "multiset-filter" (FTuple fargs)) "invalid number of arguments"
− cbs/Funcons/Core/Computations/ControlFlow/Normal/Iterating/Definite/FilteringCollections/SetFilter.hs 
@@ -1,26 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Normal/Iterating/Definite/Filtering collections/set-filter.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.SetFilter where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("set-filter",PartiallyStrictFuncon [NonStrict,Strict] stepSet_filter)]---- |--- /set-filter(P,S)/ deletes all entries from the the set /S/ that do not---   satisfy the predicate /P/ .-set_filter_ fargs = FApp "set-filter" (FTuple fargs)-stepSet_filter fargs@[arg1,arg2] =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PMetaVar "F",PAnnotated (PMetaVar "S") (TName "values")] env-            rewriteTermTo (TApp "list-to-set" (TTuple [TApp "list-filter" (TTuple [TVar "F",TApp "set-to-list" (TTuple [TVar "S"])])])) env-stepSet_filter fargs = sortErr (FApp "set-filter" (FTuple fargs)) "invalid number of arguments"
− cbs/Funcons/Core/Computations/ControlFlow/Normal/Iterating/Definite/MappingCollections/ListMap.hs 
@@ -1,30 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Normal/Iterating/Definite/Mapping collections/list-map.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.ListMap where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("list-map",PartiallyStrictFuncon [NonStrict,Strict] stepList_map)]---- |--- /list-map(F,L)/ maps the computation /F/ over the list /L/ ,---   from left to right, evaluating /F/ for each given value in /L/ .-list_map_ fargs = FApp "list-map" (FTuple fargs)-stepList_map fargs@[arg1,arg2] =-    evalRules [rewrite1,rewrite2] []-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PMetaVar "F",PValue (PList [])] env-            rewriteTo (FList [])-          rewrite2 = do-            let env = emptyEnv-            env <- fsMatch fargs [PMetaVar "F",PValue (PList [VPMetaVar "V",VPSeqVar "V*" StarOp])] env-            rewriteTermTo (TApp "cons" (TTuple [TApp "left-to-right" (TTuple [TApp "give" (TTuple [TVar "V",TVar "F"]),TApp "list-map" (TTuple [TVar "F",TList [TVar "V*"]])])])) env-stepList_map fargs = sortErr (FApp "list-map" (FTuple fargs)) "invalid number of arguments"
− cbs/Funcons/Core/Computations/ControlFlow/Normal/Iterating/Definite/MappingCollections/ListsMap.hs 
@@ -1,32 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Normal/Iterating/Definite/Mapping collections/lists-map.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.ListsMap where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("lists-map",PartiallyStrictFuncon [NonStrict,Strict] stepLists_map)]---- |--- /lists-map(F,(List+))/ maps the computation /F/ over N lists of equal length---   L, in parallel from left to right.  /F/ is evaluated L times, once for each---   given tuple of argument values, where the Nth component of each tuple is---   drawn from the Nth argument list.-lists_map_ fargs = FApp "lists-map" (FTuple fargs)-stepLists_map fargs@[arg1,arg2] =-    evalRules [rewrite1,rewrite2] []-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PMetaVar "F",PAnnotated (PMetaVar "L") (TApp "lists" (TTuple [TName "values"]))] env-            rewriteTermTo (TApp "list-map" (TTuple [TVar "F",TVar "L"])) env-          rewrite2 = do-            let env = emptyEnv-            env <- fsMatch fargs [PMetaVar "F",PAnnotated (PMetaVar "LS") (TTuple [TApp "lists" (TTuple [TName "values"]),TSortSeq (TApp "lists" (TTuple [TName "values"])) PlusOp])] env-            rewriteTermTo (TApp "give" (TTuple [TApp "tuple-map" (TTuple [TApp "is-nil" (TTuple [TName "given"]),TVar "LS"]),TApp "if-then-else" (TTuple [TApp "and" (TTuple [TName "given"]),TName "nil",TApp "if-then-else" (TTuple [TApp "or" (TTuple [TName "given"]),TName "fail",TApp "cons" (TTuple [TApp "left-to-right" (TTuple [TApp "give" (TTuple [TApp "tuple-map" (TTuple [TApp "head" (TTuple [TName "given"]),TVar "LS"]),TVar "F"]),TApp "lists-map" (TTuple [TVar "F",TApp "tuple-map" (TTuple [TApp "tail" (TTuple [TName "given"]),TVar "LS"])])])])])])])) env-stepLists_map fargs = sortErr (FApp "lists-map" (FTuple fargs)) "invalid number of arguments"
− cbs/Funcons/Core/Computations/ControlFlow/Normal/Iterating/Definite/MappingCollections/MapMap.hs 
@@ -1,26 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Normal/Iterating/Definite/Mapping collections/map-map.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.MapMap where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("map-map",PartiallyStrictFuncon [NonStrict,Strict] stepMap_map)]---- |--- /map-map(X,M)/ maps the computation /F/ over the map /M/ , interleaved,---   evaluating /F/ for each given key/entry pair in /M/ , uniting the results.-map_map_ fargs = FApp "map-map" (FTuple fargs)-stepMap_map fargs@[arg1,arg2] =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PMetaVar "F",PAnnotated (PMetaVar "M") (TName "values")] env-            rewriteTermTo (TApp "list-to-map" (TTuple [TApp "list-map" (TTuple [TTuple [TName "given1",TVar "F"],TApp "map-to-list" (TTuple [TVar "M"])])])) env-stepMap_map fargs = sortErr (FApp "map-map" (FTuple fargs)) "invalid number of arguments"
− cbs/Funcons/Core/Computations/ControlFlow/Normal/Iterating/Definite/MappingCollections/SetMap.hs 
@@ -1,26 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Normal/Iterating/Definite/Mapping collections/set-map.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.SetMap where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("set-map",PartiallyStrictFuncon [NonStrict,Strict] stepSet_map)]---- |--- /set-map(F,S)/ maps the computation /F/ over the set /S/ , interleaved,---   evaluating /F/ for each given value in /S/ , uniting the results.-set_map_ fargs = FApp "set-map" (FTuple fargs)-stepSet_map fargs@[arg1,arg2] =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PMetaVar "F",PAnnotated (PMetaVar "S") (TName "values")] env-            rewriteTermTo (TApp "list-to-set" (TTuple [TApp "list-map" (TTuple [TVar "F",TApp "set-to-list" (TTuple [TVar "S"])])])) env-stepSet_map fargs = sortErr (FApp "set-map" (FTuple fargs)) "invalid number of arguments"
− cbs/Funcons/Core/Computations/ControlFlow/Normal/Iterating/Definite/MappingCollections/TupleMap.hs 
@@ -1,26 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Normal/Iterating/Definite/Mapping collections/tuple-map.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.TupleMap where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("tuple-map",PartiallyStrictFuncon [NonStrict,Strict] stepTuple_map)]---- |--- /tuple-map(F,Tup)/ maps the computation /F/ over a tuple /Tup/ ,---   from left to right, evaluating /F/ for each given value in the /Tup/ .-tuple_map_ fargs = FApp "tuple-map" (FTuple fargs)-stepTuple_map fargs@[arg1,arg2] =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PMetaVar "F",PAnnotated (PMetaVar "Tup") (TName "values")] env-            rewriteTermTo (TApp "list-to-tuple" (TTuple [TApp "list-map" (TTuple [TVar "F",TApp "list" (TTuple [TVar "Tup"])])])) env-stepTuple_map fargs = sortErr (FApp "tuple-map" (FTuple fargs)) "invalid number of arguments"
− cbs/Funcons/Core/Computations/ControlFlow/Normal/Iterating/Definite/MappingCollections/VectorMap.hs 
@@ -1,26 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Normal/Iterating/Definite/Mapping collections/vector-map.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.VectorMap where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("vector-map",PartiallyStrictFuncon [NonStrict,Strict] stepVector_map)]---- |--- /vector-map(F,V)/ maps the computation /F/ over the vector /V/ ,---   from left to right, evaluating /F/ for each given value in /V/ . -vector_map_ fargs = FApp "vector-map" (FTuple fargs)-stepVector_map fargs@[arg1,arg2] =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PMetaVar "F",PAnnotated (PMetaVar "Vec") (TName "values")] env-            rewriteTermTo (TApp "list-to-vector" (TTuple [TApp "list-map" (TTuple [TVar "F",TApp "vector-to-list" (TTuple [TVar "Vec"])])])) env-stepVector_map fargs = sortErr (FApp "vector-map" (FTuple fargs)) "invalid number of arguments"
− cbs/Funcons/Core/Computations/ControlFlow/Normal/Iterating/Definite/ReducingCollections/ListFoldl.hs 
@@ -1,33 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Normal/Iterating/Definite/Reducing collections/list-foldl.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.ReducingCollections.ListFoldl where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("list-foldl",PartiallyStrictFuncon [NonStrict,Strict,Strict] stepList_foldl)]---- |--- /list-foldl(F,A,L)/ reduces a list /L/ to a single value by folding it from---   the left, using /A/ as the initial accumulator value, and iteratively---   updating the accumulator by executing the computation /F/ with the---   accumulator value and the head of the remaining list as its pair of---   arguments.-list_foldl_ fargs = FApp "list-foldl" (FTuple fargs)-stepList_foldl fargs@[arg1,arg2,arg3] =-    evalRules [rewrite1,rewrite2] []-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PWildCard,PMetaVar "A",PValue (PList [])] env-            rewriteTermTo (TVar "A") env-          rewrite2 = do-            let env = emptyEnv-            env <- fsMatch fargs [PMetaVar "F",PMetaVar "A",PValue (PList [VPMetaVar "V",VPSeqVar "V*" StarOp])] env-            rewriteTermTo (TApp "list-foldl" (TTuple [TVar "F",TApp "give" (TTuple [TTuple [TVar "A",TVar "V"],TVar "F"]),TList [TVar "V*"]])) env-stepList_foldl fargs = sortErr (FApp "list-foldl" (FTuple fargs)) "invalid number of arguments"
− cbs/Funcons/Core/Computations/ControlFlow/Normal/Iterating/Definite/ReducingCollections/ListFoldr.hs 
@@ -1,33 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Normal/Iterating/Definite/Reducing collections/list-foldr.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.ReducingCollections.ListFoldr where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("list-foldr",PartiallyStrictFuncon [NonStrict,Strict,Strict] stepList_foldr)]---- |--- /list-foldr(F,A,L)/ reduces a list /L/ to a single value by folding it from---   the right, using /A/ as the initial accumulator value, and iteratively---   updating the accumulator by executing the computation /F/ with the---   the last element of the remaining list and the accumulator value as its pair---   of arguments.-list_foldr_ fargs = FApp "list-foldr" (FTuple fargs)-stepList_foldr fargs@[arg1,arg2,arg3] =-    evalRules [rewrite1,rewrite2] []-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PWildCard,PValue (PList []),PMetaVar "A"] env-            rewriteTermTo (TVar "A") env-          rewrite2 = do-            let env = emptyEnv-            env <- fsMatch fargs [PMetaVar "F",PValue (PList [VPMetaVar "V",VPSeqVar "V*" StarOp]),PMetaVar "A"] env-            rewriteTermTo (TApp "give" (TTuple [TTuple [TVar "V",TApp "list-foldr" (TTuple [TVar "F",TList [TVar "V*"],TVar "A"])],TVar "F"])) env-stepList_foldr fargs = sortErr (FApp "list-foldr" (FTuple fargs)) "invalid number of arguments"
− cbs/Funcons/Core/Computations/ControlFlow/Normal/Iterating/Indefinite/DoWhile.hs 
@@ -1,26 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Normal/Iterating/Indefinite/do-while.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Normal.Iterating.Indefinite.DoWhile where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("do-while",NonStrictFuncon stepDo_while)]---- |--- /do-while(C,B)/ first executes /C/ .---   Then it evaluates /B/ .  Depending on whether the value is /true/ or /false/ , ---   it then repeats, or terminates normally.-do_while_ fargs = FApp "do-while" (FTuple fargs)-stepDo_while fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PMetaVar "C",PMetaVar "B"] env-            rewriteTermTo (TApp "sequential" (TTuple [TVar "C",TApp "if-then-else" (TTuple [TVar "B",TApp "do-while" (TTuple [TVar "C",TVar "B"]),TTuple []])])) env
− cbs/Funcons/Core/Computations/ControlFlow/Normal/Iterating/Indefinite/While.hs 
@@ -1,26 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Normal/Iterating/Indefinite/while.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Normal.Iterating.Indefinite.While where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("while",NonStrictFuncon stepWhile)]---- |--- /while(B,C)/ first evaluates /B/ .---   Depending on whether the computed value is /true/ or /false/ , ---   it then executes /C/ and repeats, or terminates normally.-while_ fargs = FApp "while" (FTuple fargs)-stepWhile fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PMetaVar "B",PMetaVar "C"] env-            rewriteTermTo (TApp "if-then-else" (TTuple [TVar "B",TApp "sequential" (TTuple [TVar "C",TApp "while" (TTuple [TVar "B",TVar "C"])]),TTuple []])) env
− cbs/Funcons/Core/Computations/ControlFlow/Normal/Sequencing/Atomic.hs 
@@ -1,31 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Normal/Sequencing/atomic.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Normal.Sequencing.Atomic where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("atomic",NonStrictFuncon stepAtomic)]---- |--- /atomic(X)/ treats the complete evaluation of /X/ as one step,---   regardless of how many steps that evaluation actually takes.-atomic_ fargs = FApp "atomic" (FTuple fargs)-stepAtomic fargs =-    evalRules [rewrite1] [step1]-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PAnnotated (PMetaVar "V") (TName "values")] env-            rewriteTermTo (TVar "V") env-          step1 = do-            let env = emptyEnv-            env <- lifted_fsMatch fargs [PMetaVar "X"] env-            env <- premise (TVar "X") (PMetaVar "X'") env-            env <- premise (TApp "atomic" (TTuple [TVar "X'"])) (PMetaVar "V") env-            stepTermTo (TVar "V") env
− cbs/Funcons/Core/Computations/ControlFlow/Normal/Sequencing/LeftToRight.hs 
@@ -1,30 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Normal/Sequencing/left-to-right.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Normal.Sequencing.LeftToRight where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("left-to-right",NonStrictFuncon stepLeft_to_right)]---- |--- /left-to-right(X1,...,Xn)/ executes /X1/ ,...,/Xn/ from left to right,---   computing a tuple of result values /(V1,...,VN)/ .-left_to_right_ fargs = FApp "left-to-right" (FTuple fargs)-stepLeft_to_right fargs =-    evalRules [rewrite1] [step1]-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PAnnotated (PSeqVar "V*" StarOp) (TName "values")] env-            rewriteTermTo (TTuple [TVar "V*"]) env-          step1 = do-            let env = emptyEnv-            env <- lifted_fsMatch fargs [PAnnotated (PSeqVar "V*" StarOp) (TName "values"),PMetaVar "Y",PSeqVar "Z*" StarOp] env-            env <- premise (TVar "Y") (PMetaVar "Y'") env-            stepTermTo (TApp "left-to-right" (TTuple [TVar "V*",TVar "Y'",TVar "Z*"])) env
− cbs/Funcons/Core/Computations/ControlFlow/Normal/Sequencing/Sequential.hs 
@@ -1,27 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Control flow/Normal/Sequencing/sequential.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.ControlFlow.Normal.Sequencing.Sequential where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("sequential",NonStrictFuncon stepSequential)]---- |--- /sequential(X1,...,Xn)/ executes /X1/ ,...,/Xn/ from left to right,---   computing a tuple of results.---   Any result values that are the empty tuple /()/ are discarded,---   so the resultant tuple may be smaller.-sequential_ fargs = FApp "sequential" (FTuple fargs)-stepSequential fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PSeqVar "X*" StarOp] env-            rewriteTermTo (TApp "discard-empty-tuples" (TTuple [TApp "left-to-right" (TTuple [TVar "X*"])])) env
− cbs/Funcons/Core/Computations/DataFlow/Binding/Accumulate.hs 
@@ -1,40 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Binding/accumulate.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Binding.Accumulate where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("accumulate",NonStrictFuncon stepAccumulate)]---- |--- /accumulate(D1,D*)/ first evaluates /D1/ to /Rho1/ .---   It then lets /Rho1/ override the current environment during the evaluation---   of /accumulate(D*)/ to /Rho2/ , and finally computes /Rho2/ overriding /Rho1/ .---   /accumulate()/ computes /map-empty/ .-accumulate_ fargs = FApp "accumulate" (FTuple fargs)-stepAccumulate fargs =-    evalRules [rewrite1,rewrite2,rewrite3] [step1]-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [] env-            rewriteTo (FName "map-empty")-          rewrite2 = do-            let env = emptyEnv-            env <- fsMatch fargs [PAnnotated (PMetaVar "Rho") (TName "environments")] env-            rewriteTermTo (TVar "Rho") env-          rewrite3 = do-            let env = emptyEnv-            env <- fsMatch fargs [PAnnotated (PMetaVar "Rho") (TName "environments"),PSeqVar "D+" PlusOp] env-            rewriteTermTo (TApp "scope" (TTuple [TVar "Rho",TApp "map-override" (TTuple [TApp "accumulate" (TTuple [TVar "D+"]),TVar "Rho"])])) env-          step1 = do-            let env = emptyEnv-            env <- lifted_fsMatch fargs [PMetaVar "D",PSeqVar "D*" StarOp] env-            env <- premise (TVar "D") (PMetaVar "D'") env-            stepTermTo (TApp "accumulate" (TTuple [TVar "D'",TVar "D*"])) env
− cbs/Funcons/Core/Computations/DataFlow/Binding/Bind.hs 
@@ -1,24 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Binding/bind.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Binding.Bind where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("bind",StrictFuncon stepBind)]---- |--- /bind(B,V)/ gives the environment binding the binder /B/ to the value /V/ .-bind_ fargs = FApp "bind" (FTuple fargs)-stepBind fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "B") (TName "values"),VPAnnotated (VPMetaVar "V") (TName "values")] env-            rewriteTermTo (TMap [TTuple [TVar "B",TVar "V"]]) env
− cbs/Funcons/Core/Computations/DataFlow/Binding/Bound.hs 
@@ -1,32 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Binding/bound.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Binding.Bound where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("bound",StrictFuncon stepBound)]---- |--- /bound(B)/ returns the value currently bound to the binder /B/ ,-bound_ fargs = FApp "bound" (FTuple fargs)-stepBound fargs =-    evalRules [] [step1,step2]-    where step1 = do-            let env = emptyEnv-            env <- lifted_vsMatch fargs [VPMetaVar "B"] env-            env <- getInhPatt "environment" (VPMetaVar "Rho") env-            env <- lifted_sideCondition (SCEquality (TApp "is-in-set" (TTuple [TVar "B",TApp "domain" (TTuple [TVar "Rho"])])) (TName "true")) env-            stepTermTo (TApp "lookup" (TTuple [TVar "B",TVar "Rho"])) env-          step2 = do-            let env = emptyEnv-            env <- lifted_vsMatch fargs [VPMetaVar "B"] env-            env <- getInhPatt "environment" (VPMetaVar "Rho") env-            env <- lifted_sideCondition (SCEquality (TApp "is-in-set" (TTuple [TVar "B",TApp "domain" (TTuple [TVar "Rho"])])) (TName "false")) env-            stepTo (FName "fail")
− cbs/Funcons/Core/Computations/DataFlow/Binding/Environment.hs 
@@ -1,14 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Binding/environment.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Binding.Environment where--import Funcons.EDSL--entities = [DefInherited "environment" (FName "map-empty")]--types = typeEnvFromList-    []--funcons = libFromList-    []
− cbs/Funcons/Core/Computations/DataFlow/Binding/Environments.hs 
@@ -1,31 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Binding/environments.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Binding.Environments where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    [("binders",DataTypeMembers [] [DataTypeInclusion (TName "ids"),DataTypeConstructor "id-in-namespace" (TTuple [TName "ids",TName "namespace-names"])])]--funcons = libFromList-    [("environments",NullaryFuncon stepEnvironments),("namespace-names",NullaryFuncon stepNamespace_names),("binders",NullaryFuncon stepBinders),("id-in-namespace",StrictFuncon stepId_in_namespace)]--environments_ = FName "environments"-stepEnvironments = evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            rewriteTo (FApp "maps" (FTuple [FName "binders",FName "values"]))--namespace_names_ = FName "namespace-names"-stepNamespace_names = evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            rewriteTo (FName "values")---stepId_in_namespace vs = rewritten (ADTVal "id-in-namespace" vs)--stepBinders = rewriteType "binders" []
− cbs/Funcons/Core/Computations/DataFlow/Binding/Recursion/BindRecursively.hs 
@@ -1,26 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Binding/Recursion/bind-recursively.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Binding.Recursion.BindRecursively where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("bind-recursively",PartiallyStrictFuncon [Strict,NonStrict] stepBind_recursively)]---- |--- /bind-recursively(B,E)/ binds /B/ to the result of evaluating /E/ , which may---   recursively refer to /B/ (using /bound-recursively/ ).   -bind_recursively_ fargs = FApp "bind-recursively" (FTuple fargs)-stepBind_recursively fargs@[arg1,arg2] =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PAnnotated (PMetaVar "B") (TName "values"),PMetaVar "E"] env-            rewriteTermTo (TApp "recursive" (TTuple [TSet [TVar "B"],TApp "bind" (TTuple [TVar "B",TVar "E"])])) env-stepBind_recursively fargs = sortErr (FApp "bind-recursively" (FTuple fargs)) "invalid number of arguments"
− cbs/Funcons/Core/Computations/DataFlow/Binding/Recursion/BoundRecursively.hs 
@@ -1,27 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Binding/Recursion/bound-recursively.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Binding.Recursion.BoundRecursively where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("bound-recursively",StrictFuncon stepBound_recursively)]---- |--- /bound-recursively(B)/ returns the value currently bound to /B/ , unless that---  value is a /links/ , in which case it returns the value linked to by that link.---  This is intended to be used in situations when the binder /B/ may be a---  recursive binding formed using /recursive/ or /bind-recursively/ .-bound_recursively_ fargs = FApp "bound-recursively" (FTuple fargs)-stepBound_recursively fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "B") (TName "values")] env-            rewriteTermTo (TApp "follow-if-link" (TTuple [TApp "bound" (TTuple [TVar "B"])])) env
− cbs/Funcons/Core/Computations/DataFlow/Binding/Recursion/Recursive.hs 
@@ -1,51 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Binding/Recursion/recursive.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Binding.Recursion.Recursive where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("recursive",PartiallyStrictFuncon [Strict,NonStrict] stepRecursive),("bind-to-forward-links",StrictFuncon stepBind_to_forward_links),("set-forward-links",StrictFuncon stepSet_forward_links),("reclose",PartiallyStrictFuncon [Strict,NonStrict] stepReclose)]---- |--- /recursive(Bs,D)/ evaluates /D/ with potential recursion on the binders---   in /Bs/ (which need not be the same as the set of binders bound by /D/ ).-recursive_ fargs = FApp "recursive" (FTuple fargs)-stepRecursive fargs@[arg1,arg2] =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PAnnotated (PMetaVar "Bs") (TName "values"),PMetaVar "Decl"] env-            rewriteTermTo (TApp "reclose" (TTuple [TApp "bind-to-forward-links" (TTuple [TVar "Bs"]),TVar "Decl"])) env-stepRecursive fargs = sortErr (FApp "recursive" (FTuple fargs)) "invalid number of arguments"--bind_to_forward_links_ fargs = FApp "bind-to-forward-links" (FTuple fargs)-stepBind_to_forward_links fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "Bs") (TName "values")] env-            rewriteTermTo (TApp "set-to-map" (TTuple [TApp "set-map" (TTuple [TTuple [TName "given",TApp "allocate-link" (TTuple [TName "values"])],TVar "Bs"])])) env--set_forward_links_ fargs = FApp "set-forward-links" (FTuple fargs)-stepSet_forward_links fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "M") (TName "values")] env-            rewriteTermTo (TApp "effect" (TTuple [TApp "map-map" (TTuple [TApp "set-link" (TTuple [TName "given2",TApp "bound" (TTuple [TName "given1"])]),TVar "M"])])) env--reclose_ fargs = FApp "reclose" (FTuple fargs)-stepReclose fargs@[arg1,arg2] =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PAnnotated (PMetaVar "M") (TName "values"),PMetaVar "Decl"] env-            rewriteTermTo (TApp "accumulate" (TTuple [TApp "scope" (TTuple [TVar "M",TVar "Decl"]),TApp "sequential" (TTuple [TApp "set-forward-links" (TTuple [TVar "M"]),TName "map-empty"])])) env-stepReclose fargs = sortErr (FApp "reclose" (FTuple fargs)) "invalid number of arguments"
− cbs/Funcons/Core/Computations/DataFlow/Binding/Scope.hs 
@@ -1,32 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Binding/scope.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Binding.Scope where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("scope",PartiallyStrictFuncon [Strict,NonStrict] stepScope)]---- |--- /scope(Rho,X)/ extends (possibly overriding) the current environment ---   with /Rho/ for the execution of /X/ .-scope_ fargs = FApp "scope" (FTuple fargs)-stepScope fargs@[arg1,arg2] =-    evalRules [rewrite1] [step1]-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PAnnotated (PWildCard) (TName "environments"),PAnnotated (PMetaVar "V") (TName "values")] env-            rewriteTermTo (TVar "V") env-          step1 = do-            let env = emptyEnv-            env <- lifted_fsMatch fargs [PAnnotated (PMetaVar "Rho1") (TName "environments"),PMetaVar "X"] env-            env <- getInhPatt "environment" (VPMetaVar "Rho0") env-            env <- withInhTerm "environment" (TTuple [TApp "map-override" (TTuple [TVar "Rho1",TVar "Rho0"])]) env (premise (TVar "X") (PMetaVar "X'") env)-            stepTermTo (TApp "scope" (TTuple [TVar "Rho1",TVar "X'"])) env-stepScope fargs = sortErr (FApp "scope" (FTuple fargs)) "invalid number of arguments"
− cbs/Funcons/Core/Computations/DataFlow/Effect.hs 
@@ -1,24 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/effect.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Effect where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("effect",StrictFuncon stepEffect)]---- |--- /effect(E)/ evaluates /E/ , then discards the computed value.-effect_ fargs = FApp "effect" (FTuple fargs)-stepEffect fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPWildCard) (TName "values")] env-            rewriteTo (FTuple [])
− cbs/Funcons/Core/Computations/DataFlow/Generating/AtomGenerator.hs 
@@ -1,14 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Generating/atom-generator.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Generating.AtomGenerator where--import Funcons.EDSL--entities = [DefMutable "atom-generator" (FName "atom-seed")]--types = typeEnvFromList-    []--funcons = libFromList-    []
− cbs/Funcons/Core/Computations/DataFlow/Generating/FreshAtom.hs 
@@ -1,24 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Generating/fresh-atom.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Generating.FreshAtom where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("fresh-atom",NullaryFuncon stepFresh_atom)]---- |--- /fresh-atom/ computes a fresh atom, distinct from all other /atoms/ previously generated by other occurrences of /fresh-atom/ .-fresh_atom_ = FName "fresh-atom"-stepFresh_atom = evalRules [] [step1]-    where step1 = do-            let env = emptyEnv-            env <- getMutPatt "atom-generator" (VPMetaVar "K") env-            putMutTerm "atom-generator" (TTuple [TApp "next-atom" (TTuple [TVar "K"])]) env-            stepTermTo (TVar "K") env
− cbs/Funcons/Core/Computations/DataFlow/Generating/FreshBinder.hs 
@@ -1,23 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Generating/fresh-binder.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Generating.FreshBinder where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("fresh-binder",NullaryFuncon stepFresh_binder)]---- |--- /fresh-binder/ generates a fresh binder, distinct from all identifiers and---   any binders previously generated by other occurrences of /fresh-binder/ .-fresh_binder_ = FName "fresh-binder"-stepFresh_binder = evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            rewriteTo (FApp "id-in-namespace" (FTuple [FValue (String "generated-binder"),FName "fresh-atom"]))
− cbs/Funcons/Core/Computations/DataFlow/Giving/Give.hs 
@@ -1,31 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Giving/give.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Giving.Give where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("give",PartiallyStrictFuncon [Strict,NonStrict] stepGive)]---- |--- /give(V,X)/ evaluates /X/ with /V/ as the given value.-give_ fargs = FApp "give" (FTuple fargs)-stepGive fargs@[arg1,arg2] =-    evalRules [rewrite1] [step1]-    where rewrite1 = do-            let env = emptyEnv-            env <- fsMatch fargs [PAnnotated (PWildCard) (TName "values"),PAnnotated (PMetaVar "V") (TName "values")] env-            rewriteTermTo (TVar "V") env-          step1 = do-            let env = emptyEnv-            env <- lifted_fsMatch fargs [PAnnotated (PMetaVar "V") (TName "values"),PMetaVar "X"] env-            env <- getInhPatt "given-value" (VPWildCard) env-            env <- withInhTerm "given-value" (TTuple [TVar "V"]) env (premise (TVar "X") (PMetaVar "X'") env)-            stepTermTo (TApp "give" (TTuple [TVar "V",TVar "X'"])) env-stepGive fargs = sortErr (FApp "give" (FTuple fargs)) "invalid number of arguments"
− cbs/Funcons/Core/Computations/DataFlow/Giving/Given.hs 
@@ -1,45 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Giving/given.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Giving.Given where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("given",NullaryFuncon stepGiven),("given1",NullaryFuncon stepGiven1),("given2",NullaryFuncon stepGiven2),("given3",NullaryFuncon stepGiven3)]---- |--- /given/ returns the current given value.-given_ = FName "given"-stepGiven = evalRules [] [step1]-    where step1 = do-            let env = emptyEnv-            env <- getInhPatt "given-value" (VPMetaVar "V") env-            stepTermTo (TVar "V") env---- |--- /given1/ returns the first component of the currently given tuple.---   /given2/ returns the second component of the currently given tuple.---   /given3/ returns the third component of the currently given tuple.-given1_ = FName "given1"-stepGiven1 = evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            rewriteTo (FApp "tuple-index" (FTuple [FName "given",FValue (Nat 1)]))--given2_ = FName "given2"-stepGiven2 = evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            rewriteTo (FApp "tuple-index" (FTuple [FName "given",FValue (Nat 2)]))--given3_ = FName "given3"-stepGiven3 = evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            rewriteTo (FApp "tuple-index" (FTuple [FName "given",FValue (Nat 3)]))
− cbs/Funcons/Core/Computations/DataFlow/Giving/GivenValue.hs 
@@ -1,14 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Giving/given-value.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Giving.GivenValue where--import Funcons.EDSL--entities = [DefInherited "given-value" (FTuple [])]--types = typeEnvFromList-    []--funcons = libFromList-    []
− cbs/Funcons/Core/Computations/DataFlow/Interacting/Print.hs 
@@ -1,26 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Interacting/print.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Interacting.Print where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("print",StrictFuncon stepPrint)]---- |--- /print(E)/ evaluates /E/ and emits the resulting value---   on the /standard-out/ .-print_ fargs = FApp "print" (FTuple fargs)-stepPrint fargs =-    evalRules [] [step1]-    where step1 = do-            let env = emptyEnv-            env <- lifted_vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values")] env-            writeOutTerm "standard-out" (TList [TVar "V"]) env-            stepTo (FTuple [])
− cbs/Funcons/Core/Computations/DataFlow/Interacting/PrintList.hs 
@@ -1,25 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Interacting/print-list.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Interacting.PrintList where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("print-list",StrictFuncon stepPrint_list)]---- |--- /print-list(L)/ emits the values contained in the list /L/ on the /standard-out/ .-print_list_ fargs = FApp "print-list" (FTuple fargs)-stepPrint_list fargs =-    evalRules [] [step1]-    where step1 = do-            let env = emptyEnv-            env <- lifted_vsMatch fargs [VPAnnotated (VPMetaVar "L") (TApp "lists" (TTuple [TName "values"]))] env-            writeOutTerm "standard-out" (TTuple [TVar "L"]) env-            stepTo (FTuple [])
− cbs/Funcons/Core/Computations/DataFlow/Interacting/Read.hs 
@@ -1,23 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Interacting/read.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Interacting.Read where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("read",NullaryFuncon stepRead)]---- |--- /read/ consumes a single value from the /standard-in/ , and returns it.-read_ = FName "read"-stepRead = evalRules [] [step1]-    where step1 = do-            let env = emptyEnv-            env <- assignInput "standard-in" "V" env-            stepTermTo (TVar "V") env
− cbs/Funcons/Core/Computations/DataFlow/Interacting/StandardIn.hs 
@@ -1,14 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Interacting/standard-in.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Interacting.StandardIn where--import Funcons.EDSL--entities = [DefInput "standard-in"]--types = typeEnvFromList-    []--funcons = libFromList-    []
− cbs/Funcons/Core/Computations/DataFlow/Interacting/StandardOut.hs 
@@ -1,14 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Interacting/standard-out.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Interacting.StandardOut where--import Funcons.EDSL--entities = [DefOutput "standard-out"]--types = typeEnvFromList-    []--funcons = libFromList-    []
− cbs/Funcons/Core/Computations/DataFlow/Linking/AllocateInitialisedLink.hs 
@@ -1,26 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Linking/allocate-initialised-link.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Linking.AllocateInitialisedLink where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("allocate-initialised-link",StrictFuncon stepAllocate_initialised_link)]---- |--- /allocate-initialised-link(T,V)/ computes a link to values of type /T/ ,---   and sets its value to /V/ .---   This /fail/ s if the type of /V/ is not a subtype of /T/ .-allocate_initialised_link_ fargs = FApp "allocate-initialised-link" (FTuple fargs)-stepAllocate_initialised_link fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "T") (TName "values"),VPAnnotated (VPMetaVar "V") (TName "values")] env-            rewriteTermTo (TApp "give" (TTuple [TApp "allocate-link" (TTuple [TVar "T"]),TApp "sequential" (TTuple [TApp "set-link" (TTuple [TName "given",TVar "V"]),TName "given"])])) env
− cbs/Funcons/Core/Computations/DataFlow/Linking/AllocateLink.hs 
@@ -1,30 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Linking/allocate-link.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Linking.AllocateLink where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("allocate-link",StrictFuncon stepAllocate_link)]---- |--- /allocate-link(T)/ computes a link to values of type /T/ .-allocate_link_ fargs = FApp "allocate-link" (FTuple fargs)-stepAllocate_link fargs =-    evalRules [] [step1]-    where step1 = do-            let env = emptyEnv-            env <- lifted_vsMatch fargs [VPAnnotated (VPMetaVar "T") (TName "types")] env-            env <- getMutPatt "link-store" (VPMetaVar "Sigma") env-            putMutTerm "link-store" (TTuple [TVar "Sigma"]) env-            env <- premise (TName "fresh-atom") (PMetaVar "K") env-            env <- getMutPatt "link-store" (VPMetaVar "Sigma'") env-            env <- lifted_sideCondition (SCPatternMatch (TApp "simple-link" (TTuple [TVar "K",TVar "T"])) (VPMetaVar "L")) env-            putMutTerm "link-store" (TTuple [TApp "map-unite" (TTuple [TVar "Sigma'",TMap [TTuple [TVar "L",TName "uninitialised"]]])]) env-            stepTermTo (TVar "L") env
− cbs/Funcons/Core/Computations/DataFlow/Linking/FollowIfLink.hs 
@@ -1,31 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Linking/follow-if-link.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Linking.FollowIfLink where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("follow-if-link",StrictFuncon stepFollow_if_link)]---- |--- If /V/ is a link, then /follow-if-link(V)/ gives the value---   to which the link /V/ has been set.  Otherwise, /V/ is returned.-follow_if_link_ fargs = FApp "follow-if-link" (FTuple fargs)-stepFollow_if_link fargs =-    evalRules [rewrite1,rewrite2] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPMetaVar "V"] env-            env <- sideCondition (SCIsInSort (TVar "V") (TName "all-links")) env-            rewriteTermTo (TApp "follow-link" (TTuple [TVar "V"])) env-          rewrite2 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPMetaVar "V"] env-            env <- sideCondition (SCNotInSort (TVar "V") (TName "all-links")) env-            rewriteTermTo (TVar "V") env
− cbs/Funcons/Core/Computations/DataFlow/Linking/FollowLink.hs 
@@ -1,43 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Linking/follow-link.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Linking.FollowLink where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("follow-link",StrictFuncon stepFollow_link)]---- |--- /follow-link(L)/ gives the value linked to by /L/ .---   If this value is /uninitialised/ , then computation /fail/ s.-follow_link_ fargs = FApp "follow-link" (FTuple fargs)-stepFollow_link fargs =-    evalRules [] [step1,step2,step3]-    where step1 = do-            let env = emptyEnv-            env <- lifted_vsMatch fargs [VPMetaVar "L"] env-            env <- getMutPatt "link-store" (VPMetaVar "Sigma") env-            env <- lifted_sideCondition (SCPatternMatch (TApp "lookup" (TTuple [TVar "L",TVar "Sigma"])) (VPMetaVar "V")) env-            env <- lifted_sideCondition (SCNotInSort (TVar "V") (TName "uninitialised-values")) env-            putMutTerm "link-store" (TTuple [TVar "Sigma"]) env-            stepTermTo (TVar "V") env-          step2 = do-            let env = emptyEnv-            env <- lifted_vsMatch fargs [VPMetaVar "L"] env-            env <- getMutPatt "link-store" (VPMetaVar "Sigma") env-            env <- lifted_sideCondition (SCIsInSort (TApp "lookup" (TTuple [TVar "L",TVar "Sigma"])) (TName "uninitialised-values")) env-            putMutTerm "link-store" (TTuple [TVar "Sigma"]) env-            stepTo (FName "fail")-          step3 = do-            let env = emptyEnv-            env <- lifted_vsMatch fargs [VPMetaVar "L"] env-            env <- getMutPatt "link-store" (VPMetaVar "Sigma") env-            env <- lifted_sideCondition (SCEquality (TApp "is-in-set" (TTuple [TVar "L",TApp "domain" (TTuple [TVar "Sigma"])])) (TName "false")) env-            putMutTerm "link-store" (TTuple [TVar "Sigma"]) env-            stepTo (FName "fail")
− cbs/Funcons/Core/Computations/DataFlow/Linking/LinkStore.hs 
@@ -1,14 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Linking/link-store.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Linking.LinkStore where--import Funcons.EDSL--entities = [DefMutable "link-store" (FName "map-empty")]--types = typeEnvFromList-    []--funcons = libFromList-    []
− cbs/Funcons/Core/Computations/DataFlow/Linking/LinkStores.hs 
@@ -1,20 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Linking/link-stores.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Linking.LinkStores where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("link-stores",NullaryFuncon stepLink_stores)]--link_stores_ = FName "link-stores"-stepLink_stores = evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            rewriteTo (FApp "maps" (FTuple [FName "all-links",FName "values"]))
− cbs/Funcons/Core/Computations/DataFlow/Linking/Links.hs 
@@ -1,61 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Linking/links.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Linking.Links where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    [("reynolds-links",DataTypeMembers [(Just "Accepting",TName "types"),(Just "Producing",TName "types")] [DataTypeConstructor "simple-link" (TTuple [TName "atoms",TName "types"]),DataTypeConstructor "reynolds-link" (TTuple [TName "atoms",TName "types",TName "types"])])]--funcons = libFromList-    [("links",StrictFuncon stepLinks),("all-links",NullaryFuncon stepAll_links),("link-accepting-type",StrictFuncon stepLink_accepting_type),("link-producing-type",StrictFuncon stepLink_producing_type),("reynolds-links",StrictFuncon stepReynolds_links),("simple-link",StrictFuncon stepSimple_link),("reynolds-link",StrictFuncon stepReynolds_link)]--links_ fargs = FApp "links" (FTuple fargs)-stepLinks fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "T") (TName "values")] env-            rewriteTermTo (TApp "reynolds-links" (TTuple [TVar "T",TVar "T"])) env--all_links_ = FName "all-links"-stepAll_links = evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            rewriteTo (FApp "reynolds-links" (FTuple [FName "empty-type",FName "values"]))---- |--- /link-accepting-type(L)/ returns the type of values that /L/ accepts.---   /link-producing-type(L)/ returns the type of values that /L/ can produce.-link_accepting_type_ fargs = FApp "link-accepting-type" (FTuple fargs)-stepLink_accepting_type fargs =-    evalRules [rewrite1,rewrite2] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [PADT "simple-link" [VPWildCard,VPMetaVar "T"]] env-            rewriteTermTo (TVar "T") env-          rewrite2 = do-            let env = emptyEnv-            env <- vsMatch fargs [PADT "reynolds-link" [VPWildCard,VPMetaVar "Accepting",VPWildCard]] env-            rewriteTermTo (TVar "Accepting") env--link_producing_type_ fargs = FApp "link-producing-type" (FTuple fargs)-stepLink_producing_type fargs =-    evalRules [rewrite1,rewrite2] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [PADT "simple-link" [VPWildCard,VPMetaVar "T"]] env-            rewriteTermTo (TVar "T") env-          rewrite2 = do-            let env = emptyEnv-            env <- vsMatch fargs [PADT "reynolds-link" [VPWildCard,VPWildCard,VPMetaVar "Producing"]] env-            rewriteTermTo (TVar "Producing") env--stepSimple_link vs = rewritten (ADTVal "simple-link" vs)--stepReynolds_link vs = rewritten (ADTVal "reynolds-link" vs)--stepReynolds_links ts = rewriteType "reynolds-links" ts
− cbs/Funcons/Core/Computations/DataFlow/Linking/SetLink.hs 
@@ -1,50 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Linking/set-link.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Linking.SetLink where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("set-link",StrictFuncon stepSet_link)]---- |--- /set-link(L,V)/ sets the value linked to by /L/ to be /V/ .---    If /L/ has already been set, then computation instead /fail/ s.-set_link_ fargs = FApp "set-link" (FTuple fargs)-stepSet_link fargs =-    evalRules [] [step1,step2,step3,step4]-    where step1 = do-            let env = emptyEnv-            env <- lifted_vsMatch fargs [VPMetaVar "L",VPMetaVar "V"] env-            env <- getMutPatt "link-store" (VPMetaVar "Sigma") env-            env <- lifted_sideCondition (SCIsInSort (TApp "lookup" (TTuple [TVar "L",TVar "Sigma"])) (TName "uninitialised-values")) env-            env <- lifted_sideCondition (SCIsInSort (TVar "V") (TApp "link-accepting-type" (TTuple [TVar "L"]))) env-            putMutTerm "link-store" (TTuple [TApp "map-override" (TTuple [TMap [TTuple [TVar "L",TVar "V"]],TVar "Sigma"])]) env-            stepTo (FTuple [])-          step2 = do-            let env = emptyEnv-            env <- lifted_vsMatch fargs [VPMetaVar "L",VPAnnotated (VPMetaVar "V") (TName "values")] env-            env <- getMutPatt "link-store" (VPMetaVar "Sigma") env-            env <- lifted_sideCondition (SCEquality (TApp "is-in-set" (TTuple [TVar "L",TApp "domain" (TTuple [TVar "Sigma"])])) (TName "false")) env-            putMutTerm "link-store" (TTuple [TVar "Sigma"]) env-            stepTo (FName "fail")-          step3 = do-            let env = emptyEnv-            env <- lifted_vsMatch fargs [VPMetaVar "L",VPAnnotated (VPMetaVar "V") (TName "values")] env-            env <- getMutPatt "link-store" (VPMetaVar "Sigma") env-            env <- lifted_sideCondition (SCNotInSort (TApp "lookup" (TTuple [TVar "L",TVar "Sigma"])) (TName "uninitialised-values")) env-            putMutTerm "link-store" (TTuple [TVar "Sigma"]) env-            stepTo (FName "fail")-          step4 = do-            let env = emptyEnv-            env <- lifted_vsMatch fargs [VPMetaVar "L",VPMetaVar "V"] env-            env <- getMutPatt "link-store" (VPMetaVar "Sigma") env-            env <- lifted_sideCondition (SCNotInSort (TVar "V") (TApp "link-accepting-type" (TTuple [TVar "L"]))) env-            putMutTerm "link-store" (TTuple [TVar "Sigma"]) env-            stepTo (FName "fail")
− cbs/Funcons/Core/Computations/DataFlow/Storing/GeneralVariables/AllocateMap.hs 
@@ -1,25 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Storing/General variables/allocate-map.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.AllocateMap where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("allocate-map",StrictFuncon stepAllocate_map)]---- |--- /allocate-map(M)/ computes a map where the entries are---   uninitialised /variables/ of types given by /M/ .-allocate_map_ fargs = FApp "allocate-map" (FTuple fargs)-stepAllocate_map fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "M") (TName "values")] env-            rewriteTermTo (TApp "map-map" (TTuple [TApp "allocate-variable" (TTuple [TName "given2"]),TVar "M"])) env
− cbs/Funcons/Core/Computations/DataFlow/Storing/GeneralVariables/AllocateVector.hs 
@@ -1,25 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Storing/General variables/allocate-vector.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.AllocateVector where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("allocate-vector",StrictFuncon stepAllocate_vector)]---- |--- /allocate-vector(T,N)/ computes a vector of length /N/ ,---   containing uninitialised /variables/ of type /T/ .-allocate_vector_ fargs = FApp "allocate-vector" (FTuple fargs)-stepAllocate_vector fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "T") (TName "values"),VPAnnotated (VPMetaVar "N") (TName "values")] env-            rewriteTermTo (TApp "vector-map" (TTuple [TApp "allocate-variable" (TTuple [TName "given"]),TApp "vector-repeat" (TTuple [TVar "N",TVar "T"])])) env
− cbs/Funcons/Core/Computations/DataFlow/Storing/GeneralVariables/GeneralAssign.hs 
@@ -1,67 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Storing/General variables/general-assign.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.GeneralAssign where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("general-assign",StrictFuncon stepGeneral_assign)]---- |--- /general-assign(Var,Val)/ assigns the (potentially composite) value /Val/ to---   the (potentialy composite) variable /Var/ .-general_assign_ fargs = FApp "general-assign" (FTuple fargs)-stepGeneral_assign fargs =-    evalRules [rewrite1,rewrite2,rewrite3,rewrite4,rewrite5,rewrite6,rewrite7,rewrite8,rewrite9] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "Var") (TName "all-variables"),VPAnnotated (VPMetaVar "Val") (TName "values")] env-            rewriteTermTo (TApp "assign" (TTuple [TVar "Var",TVar "Val"])) env-          rewrite2 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPMetaVar "Var",VPAnnotated (VPMetaVar "Val") (TName "values")] env-            env <- sideCondition (SCNotInSort (TVar "Var") (TName "all-variables")) env-            env <- sideCondition (SCNotInSort (TVar "Var") (TApp "thunks" (TTuple [TSortComputesFrom (TName "values") (TName "environments")]))) env-            env <- sideCondition (SCNotInSort (TVar "Var") (TName "algebraic-datatypes")) env-            env <- sideCondition (SCNotInSort (TVar "Var") (TApp "lists" (TTuple [TName "values"]))) env-            env <- sideCondition (SCNotInSort (TVar "Var") (TApp "maps" (TTuple [TName "values",TName "values"]))) env-            env <- sideCondition (SCNotInSort (TVar "Var") (TApp "tuples" (TTuple [TName "values",TSortSeq (TName "values") PlusOp]))) env-            env <- sideCondition (SCNotInSort (TVar "Var") (TApp "vectors" (TTuple [TName "values"]))) env-            rewriteTermTo (TApp "check-true" (TTuple [TApp "is-equal" (TTuple [TVar "Var",TVar "Val"])])) env-          rewrite3 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "Var") (TName "algebraic-datatypes"),VPAnnotated (VPMetaVar "Val") (TName "values")] env-            rewriteTermTo (TApp "sequential" (TTuple [TApp "check-true" (TTuple [TApp "is-in-type" (TTuple [TVar "Val",TName "algebraic-datatypes"])]),TApp "check-true" (TTuple [TApp "is-equal" (TTuple [TApp "algebraic-datatype-constructor" (TTuple [TVar "Var"]),TApp "algebraic-datatype-constructor" (TTuple [TVar "Val"])])]),TApp "general-assign" (TTuple [TApp "algebraic-datatype-value" (TTuple [TVar "Var"]),TApp "algebraic-datatype-value" (TTuple [TVar "Val"])])])) env-          rewrite4 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "Var") (TApp "lists" (TTuple [TName "values"])),VPAnnotated (VPMetaVar "Val") (TName "values")] env-            rewriteTermTo (TApp "sequential" (TTuple [TApp "check-true" (TTuple [TApp "is-in-type" (TTuple [TVar "Val",TApp "lists" (TTuple [TName "values"])])]),TApp "effect" (TTuple [TApp "lists-map" (TTuple [TApp "general-assign" (TTuple [TName "given"]),TTuple [TVar "Var",TVar "Val"]])])])) env-          rewrite5 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPMetaVar "Var",VPAnnotated (VPMetaVar "Val") (TName "values")] env-            env <- sideCondition (SCEquality (TVar "Var") (TName "map-empty")) env-            rewriteTermTo (TApp "check-true" (TTuple [TApp "is-equal" (TTuple [TVar "Val",TName "map-empty"])])) env-          rewrite6 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "VarM") (TApp "maps" (TTuple [TName "values",TName "values"])),VPAnnotated (VPMetaVar "ValM") (TName "values")] env-            env <- sideCondition (SCPatternMatch (TApp "some-element" (TTuple [TApp "domain" (TTuple [TVar "VarM"])])) (VPMetaVar "K")) env-            rewriteTermTo (TApp "sequential" (TTuple [TApp "check-true" (TTuple [TApp "is-in-type" (TTuple [TVar "ValM",TApp "maps" (TTuple [TName "values",TName "values"])])]),TApp "check-true" (TTuple [TApp "is-equal" (TTuple [TApp "domain" (TTuple [TVar "VarM"]),TApp "domain" (TTuple [TVar "ValM"])])]),TApp "effect" (TTuple [TApp "general-assign" (TTuple [TApp "lookup" (TTuple [TVar "K",TVar "VarM"]),TApp "lookup" (TTuple [TVar "K",TVar "ValM"])]),TApp "general-assign" (TTuple [TApp "map-delete" (TTuple [TVar "VarM",TSet [TVar "K"]]),TApp "map-delete" (TTuple [TVar "ValM",TSet [TVar "K"]])])])])) env-          rewrite7 = do-            let env = emptyEnv-            env <- vsMatch fargs [PTuple [VPAnnotated (VPMetaVar "Var") (TName "values"),VPAnnotated (VPSeqVar "Var+" PlusOp) (TName "values")],PTuple [VPAnnotated (VPMetaVar "Val") (TName "values"),VPAnnotated (VPSeqVar "Val+" PlusOp) (TName "values")]] env-            rewriteTermTo (TApp "effect" (TTuple [TApp "general-assign" (TTuple [TVar "Var",TVar "Val"]),TApp "general-assign" (TTuple [TTuple [TVar "Var+"],TTuple [TVar "Val+"]])])) env-          rewrite8 = do-            let env = emptyEnv-            env <- vsMatch fargs [PTuple [VPAnnotated (VPMetaVar "Var") (TName "values"),VPAnnotated (VPSeqVar "Var+" PlusOp) (TName "values")],VPAnnotated (VPMetaVar "Val") (TName "values")] env-            env <- sideCondition (SCNotInSort (TVar "Val") (TApp "tuples" (TTuple [TName "values",TSortSeq (TName "values") PlusOp]))) env-            rewriteTo (FName "fail")-          rewrite9 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "Var") (TApp "vectors" (TTuple [TName "values"])),VPAnnotated (VPMetaVar "Val") (TName "values")] env-            rewriteTermTo (TApp "sequential" (TTuple [TApp "check-true" (TTuple [TApp "is-in-type" (TTuple [TVar "Val",TApp "vectors" (TTuple [TName "values"])])]),TApp "general-assign" (TTuple [TApp "vector-to-list" (TTuple [TVar "Var"]),TApp "vector-to-list" (TTuple [TVar "Val"])])])) env
− cbs/Funcons/Core/Computations/DataFlow/Storing/GeneralVariables/GeneralAssigned.hs 
@@ -1,56 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Storing/General variables/general-assigned.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.GeneralAssigned where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("general-assigned",StrictFuncon stepGeneral_assigned)]---- |--- /general-assigned(V)/ takes a (potentially composite) value /V/ , which may---   contain /variables/ , and computes the value of /V/ with all such contained---   variables replaced by the values currently assigned to those variables.-general_assigned_ fargs = FApp "general-assigned" (FTuple fargs)-stepGeneral_assigned fargs =-    evalRules [rewrite1,rewrite2,rewrite3,rewrite4,rewrite5,rewrite6,rewrite7] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPMetaVar "V"] env-            env <- sideCondition (SCNotInSort (TVar "V") (TName "all-variables")) env-            env <- sideCondition (SCNotInSort (TVar "V") (TName "algebraic-datatypes")) env-            env <- sideCondition (SCNotInSort (TVar "V") (TApp "lists" (TTuple [TName "values"]))) env-            env <- sideCondition (SCNotInSort (TVar "V") (TApp "maps" (TTuple [TName "values",TName "values"]))) env-            env <- sideCondition (SCNotInSort (TVar "V") (TApp "tuples" (TTuple [TName "values",TSortSeq (TName "values") PlusOp]))) env-            env <- sideCondition (SCNotInSort (TVar "V") (TApp "vectors" (TTuple [TName "values"]))) env-            rewriteTermTo (TVar "V") env-          rewrite2 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "Var") (TName "all-variables")] env-            rewriteTermTo (TApp "assigned" (TTuple [TVar "Var"])) env-          rewrite3 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "ADT") (TName "algebraic-datatypes")] env-            rewriteTermTo (TApp "algebraic-datatype" (TTuple [TApp "algebraic-datatype-constructor" (TTuple [TVar "ADT"]),TApp "general-assigned" (TTuple [TApp "algebraic-datatype-value" (TTuple [TVar "ADT"])])])) env-          rewrite4 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "L") (TApp "lists" (TTuple [TName "values"]))] env-            rewriteTermTo (TApp "list-map" (TTuple [TApp "general-assigned" (TTuple [TName "given"]),TVar "L"])) env-          rewrite5 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "M") (TApp "maps" (TTuple [TName "values",TName "values"]))] env-            rewriteTermTo (TApp "map-map" (TTuple [TApp "general-assigned" (TTuple [TName "given2"]),TVar "M"])) env-          rewrite6 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "T") (TApp "tuples" (TTuple [TName "values",TSortSeq (TName "values") PlusOp]))] env-            rewriteTermTo (TApp "tuple-map" (TTuple [TApp "general-assigned" (TTuple [TName "given"]),TVar "T"])) env-          rewrite7 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "Vec") (TApp "vectors" (TTuple [TName "values"]))] env-            rewriteTermTo (TApp "vector-map" (TTuple [TApp "general-assigned" (TTuple [TName "given"]),TVar "Vec"])) env
− cbs/Funcons/Core/Computations/DataFlow/Storing/SimpleVariables/AllocateInitialisedVariable.hs 
@@ -1,26 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Storing/Simple variables/allocate-initialised-variable.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.AllocateInitialisedVariable where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("allocate-initialised-variable",StrictFuncon stepAllocate_initialised_variable)]---- |--- /allocate-initialised-variable(T,V)/ computes a simple variable for storing---   values of type /T/ , and initialises its value to /V/ .---   This /fail/ s if the type of /V/ is not a subtype of /T/ .-allocate_initialised_variable_ fargs = FApp "allocate-initialised-variable" (FTuple fargs)-stepAllocate_initialised_variable fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "T") (TName "values"),VPAnnotated (VPMetaVar "V") (TName "values")] env-            rewriteTermTo (TApp "give" (TTuple [TApp "allocate-variable" (TTuple [TVar "T"]),TApp "sequential" (TTuple [TApp "assign" (TTuple [TName "given",TVar "V"]),TName "given"])])) env
− cbs/Funcons/Core/Computations/DataFlow/Storing/SimpleVariables/AllocateVariable.hs 
@@ -1,31 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Storing/Simple variables/allocate-variable.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.AllocateVariable where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("allocate-variable",StrictFuncon stepAllocate_variable)]---- |--- /allocate-variable(T)/ computes an (uninitialised) simple variable for storing--- values of type /T/ .-allocate_variable_ fargs = FApp "allocate-variable" (FTuple fargs)-stepAllocate_variable fargs =-    evalRules [] [step1]-    where step1 = do-            let env = emptyEnv-            env <- lifted_vsMatch fargs [VPAnnotated (VPMetaVar "T") (TName "types")] env-            env <- getMutPatt "store" (VPMetaVar "Sigma") env-            putMutTerm "store" (TTuple [TVar "Sigma"]) env-            env <- premise (TName "fresh-atom") (PMetaVar "K") env-            env <- getMutPatt "store" (VPMetaVar "Sigma'") env-            env <- lifted_sideCondition (SCPatternMatch (TApp "simple-variable" (TTuple [TVar "K",TVar "T"])) (VPMetaVar "Var")) env-            putMutTerm "store" (TTuple [TApp "map-unite" (TTuple [TVar "Sigma'",TMap [TTuple [TVar "Var",TName "uninitialised"]]])]) env-            stepTermTo (TVar "Var") env
− cbs/Funcons/Core/Computations/DataFlow/Storing/SimpleVariables/Assign.hs 
@@ -1,43 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Storing/Simple variables/assign.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.Assign where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("assign",StrictFuncon stepAssign)]---- |--- /assign(Var,Val)/ assigns /Val/ to the the variable /Var/ , provided /Var/ has---   not been deallocated and /Val/ is of the appropriate type for storing in /Var/ .-assign_ fargs = FApp "assign" (FTuple fargs)-stepAssign fargs =-    evalRules [] [step1,step2,step3]-    where step1 = do-            let env = emptyEnv-            env <- lifted_vsMatch fargs [VPMetaVar "Var",VPMetaVar "Val"] env-            env <- getMutPatt "store" (VPMetaVar "Sigma") env-            env <- lifted_sideCondition (SCEquality (TApp "is-in-set" (TTuple [TVar "Var",TApp "domain" (TTuple [TVar "Sigma"])])) (TName "true")) env-            env <- lifted_sideCondition (SCIsInSort (TVar "Val") (TApp "variable-accepting-type" (TTuple [TVar "Var"]))) env-            putMutTerm "store" (TTuple [TApp "map-override" (TTuple [TMap [TTuple [TVar "Var",TVar "Val"]],TVar "Sigma"])]) env-            stepTo (FTuple [])-          step2 = do-            let env = emptyEnv-            env <- lifted_vsMatch fargs [VPMetaVar "Var",VPAnnotated (VPMetaVar "Val") (TName "values")] env-            env <- getMutPatt "store" (VPMetaVar "Sigma") env-            env <- lifted_sideCondition (SCEquality (TApp "is-in-set" (TTuple [TVar "Var",TApp "domain" (TTuple [TVar "Sigma"])])) (TName "false")) env-            putMutTerm "store" (TTuple [TVar "Sigma"]) env-            stepTo (FName "fail")-          step3 = do-            let env = emptyEnv-            env <- lifted_vsMatch fargs [VPMetaVar "Var",VPMetaVar "Val"] env-            env <- getMutPatt "store" (VPMetaVar "Sigma") env-            env <- lifted_sideCondition (SCNotInSort (TVar "Val") (TApp "variable-accepting-type" (TTuple [TVar "Var"]))) env-            putMutTerm "store" (TTuple [TVar "Sigma"]) env-            stepTo (FName "fail")
− cbs/Funcons/Core/Computations/DataFlow/Storing/SimpleVariables/Assigned.hs 
@@ -1,43 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Storing/Simple variables/assigned.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.Assigned where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("assigned",StrictFuncon stepAssigned)]---- |--- /assigned(Var)/ gives the value currently assigned to the variable /Var/ .---   If this value is /uninitialised/ , then computation /fail/ s.-assigned_ fargs = FApp "assigned" (FTuple fargs)-stepAssigned fargs =-    evalRules [] [step1,step2,step3]-    where step1 = do-            let env = emptyEnv-            env <- lifted_vsMatch fargs [VPMetaVar "Var"] env-            env <- getMutPatt "store" (VPMetaVar "Sigma") env-            env <- lifted_sideCondition (SCPatternMatch (TApp "lookup" (TTuple [TVar "Var",TVar "Sigma"])) (VPMetaVar "V")) env-            env <- lifted_sideCondition (SCNotInSort (TVar "V") (TName "uninitialised-values")) env-            putMutTerm "store" (TTuple [TVar "Sigma"]) env-            stepTermTo (TVar "V") env-          step2 = do-            let env = emptyEnv-            env <- lifted_vsMatch fargs [VPMetaVar "Var"] env-            env <- getMutPatt "store" (VPMetaVar "Sigma") env-            env <- lifted_sideCondition (SCIsInSort (TApp "lookup" (TTuple [TVar "Var",TVar "Sigma"])) (TName "uninitialised-values")) env-            putMutTerm "store" (TTuple [TVar "Sigma"]) env-            stepTo (FName "fail")-          step3 = do-            let env = emptyEnv-            env <- lifted_vsMatch fargs [VPMetaVar "Var"] env-            env <- getMutPatt "store" (VPMetaVar "Sigma") env-            env <- lifted_sideCondition (SCEquality (TApp "is-in-set" (TTuple [TVar "Var",TApp "domain" (TTuple [TVar "Sigma"])])) (TName "false")) env-            putMutTerm "store" (TTuple [TVar "Sigma"]) env-            stepTo (FName "fail")
− cbs/Funcons/Core/Computations/DataFlow/Storing/SimpleVariables/CurrentValue.hs 
@@ -1,31 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Storing/Simple variables/current-value.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.CurrentValue where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("current-value",StrictFuncon stepCurrent_value)]---- |--- If /V/ is a variable, /current-value(V)/ computes the value currently---   assigned to /V/ .  Otherwise it evaluates to /V/ .-current_value_ fargs = FApp "current-value" (FTuple fargs)-stepCurrent_value fargs =-    evalRules [rewrite1,rewrite2] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPMetaVar "V"] env-            env <- sideCondition (SCIsInSort (TVar "V") (TName "all-variables")) env-            rewriteTermTo (TApp "assigned" (TTuple [TVar "V"])) env-          rewrite2 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPMetaVar "V"] env-            env <- sideCondition (SCNotInSort (TVar "V") (TName "all-variables")) env-            rewriteTermTo (TVar "V") env
− cbs/Funcons/Core/Computations/DataFlow/Storing/SimpleVariables/DeallocateVariable.hs 
@@ -1,34 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Storing/Simple variables/deallocate-variable.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.DeallocateVariable where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("deallocate-variable",StrictFuncon stepDeallocate_variable)]---- |--- /deallocate-variable(V)/ deletes the variable /V/ from the current /store/ .-deallocate_variable_ fargs = FApp "deallocate-variable" (FTuple fargs)-stepDeallocate_variable fargs =-    evalRules [] [step1,step2]-    where step1 = do-            let env = emptyEnv-            env <- lifted_vsMatch fargs [VPMetaVar "Var"] env-            env <- getMutPatt "store" (VPMetaVar "Sigma") env-            env <- lifted_sideCondition (SCEquality (TApp "is-in-set" (TTuple [TVar "Var",TApp "domain" (TTuple [TVar "Sigma"])])) (TName "true")) env-            putMutTerm "store" (TTuple [TApp "map-delete" (TTuple [TVar "Sigma",TSet [TVar "Var"]])]) env-            stepTo (FTuple [])-          step2 = do-            let env = emptyEnv-            env <- lifted_vsMatch fargs [VPMetaVar "Var"] env-            env <- getMutPatt "store" (VPMetaVar "Sigma") env-            env <- lifted_sideCondition (SCEquality (TApp "is-in-set" (TTuple [TVar "Var",TApp "domain" (TTuple [TVar "Sigma"])])) (TName "false")) env-            putMutTerm "store" (TTuple [TVar "Sigma"]) env-            stepTo (FName "fail")
− cbs/Funcons/Core/Computations/DataFlow/Storing/Store.hs 
@@ -1,14 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Storing/store.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Storing.Store where--import Funcons.EDSL--entities = [DefMutable "store" (FName "map-empty")]--types = typeEnvFromList-    []--funcons = libFromList-    []
− cbs/Funcons/Core/Computations/DataFlow/Storing/Stores.hs 
@@ -1,24 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Storing/stores.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Storing.Stores where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    [("uninitialised-values",DataTypeMembers [] [DataTypeConstructor "uninitialised" (TTuple [])])]--funcons = libFromList-    [("stores",NullaryFuncon stepStores),("uninitialised-values",NullaryFuncon stepUninitialised_values),("uninitialised",NullaryFuncon stepUninitialised)]--stores_ = FName "stores"-stepStores = evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            rewriteTo (FApp "maps" (FTuple [FName "all-variables",FName "values"]))--stepUninitialised = rewritten (ADTVal "uninitialised" [])--stepUninitialised_values = rewriteType "uninitialised-values" []
− cbs/Funcons/Core/Computations/DataFlow/Storing/Variables.hs 
@@ -1,61 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/Data flow/Storing/variables.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Storing.Variables where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    [("reynolds-variables",DataTypeMembers [(Just "Accepting",TName "types"),(Just "Producing",TName "types")] [DataTypeConstructor "simple-variable" (TTuple [TName "atoms",TName "types"]),DataTypeConstructor "reynolds-variable" (TTuple [TName "atoms",TName "types",TName "types"])])]--funcons = libFromList-    [("variables",StrictFuncon stepVariables),("all-variables",NullaryFuncon stepAll_variables),("variable-accepting-type",StrictFuncon stepVariable_accepting_type),("variable-producing-type",StrictFuncon stepVariable_producing_type),("reynolds-variables",StrictFuncon stepReynolds_variables),("simple-variable",StrictFuncon stepSimple_variable),("reynolds-variable",StrictFuncon stepReynolds_variable)]--variables_ fargs = FApp "variables" (FTuple fargs)-stepVariables fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "T") (TName "values")] env-            rewriteTermTo (TApp "reynolds-variables" (TTuple [TVar "T",TVar "T"])) env--all_variables_ = FName "all-variables"-stepAll_variables = evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            rewriteTo (FApp "reynolds-variables" (FTuple [FName "empty-type",FName "values"]))---- |--- /variable-accepting-type(Var)/ returns the type of values that /Var/ accepts.---   /variable-producing-type(Var)/ returns the type of values that /Var/ can produce.-variable_accepting_type_ fargs = FApp "variable-accepting-type" (FTuple fargs)-stepVariable_accepting_type fargs =-    evalRules [rewrite1,rewrite2] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [PADT "simple-variable" [VPWildCard,VPMetaVar "T"]] env-            rewriteTermTo (TVar "T") env-          rewrite2 = do-            let env = emptyEnv-            env <- vsMatch fargs [PADT "reynolds-variable" [VPWildCard,VPMetaVar "Accepting",VPWildCard]] env-            rewriteTermTo (TVar "Accepting") env--variable_producing_type_ fargs = FApp "variable-producing-type" (FTuple fargs)-stepVariable_producing_type fargs =-    evalRules [rewrite1,rewrite2] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [PADT "simple-variable" [VPWildCard,VPMetaVar "T"]] env-            rewriteTermTo (TVar "T") env-          rewrite2 = do-            let env = emptyEnv-            env <- vsMatch fargs [PADT "reynolds-variable" [VPWildCard,VPWildCard,VPMetaVar "Producing"]] env-            rewriteTermTo (TVar "Producing") env--stepSimple_variable vs = rewritten (ADTVal "simple-variable" vs)--stepReynolds_variable vs = rewritten (ADTVal "reynolds-variable" vs)--stepReynolds_variables ts = rewriteType "reynolds-variables" ts
+ cbs/Funcons/Core/Computations/Normal/Binding/Binding.hs view
@@ -0,0 +1,194 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Computations/Normal/Binding/Binding.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Computations.Normal.Binding.Binding where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    [("identifiers",DataTypeMemberss "identifiers" [] [DataTypeInclusionn (TName "strings"),DataTypeMemberConstructor "identifier-tagged" [TName "identifiers",TName "defined-values"] (Just [])]),("ids",DataTypeMemberss "ids" [] [DataTypeInclusionn (TName "strings"),DataTypeMemberConstructor "identifier-tagged" [TName "identifiers",TName "defined-values"] (Just [])])]++funcons = libFromList+    [("environments",NullaryFuncon stepEnvironments),("env",NullaryFuncon stepEnvironments),("envs",NullaryFuncon stepEnvironments),("identifier-tagged",StrictFuncon stepIdentifier_tagged),("id-tagged",StrictFuncon stepIdentifier_tagged),("fresh-identifier",NullaryFuncon stepFresh_identifier),("initialise-binding",NonStrictFuncon stepInitialise_binding),("bind-value",StrictFuncon stepBind_value),("bind",StrictFuncon stepBind_value),("unbind",StrictFuncon stepUnbind),("bound-directly",StrictFuncon stepBound_directly),("bound-value",StrictFuncon stepBound_value),("bound",StrictFuncon stepBound_value),("closed",NonStrictFuncon stepClosed),("scope",PartiallyStrictFuncon [Strict,NonStrict] NonStrict stepScope),("accumulate",NonStrictFuncon stepAccumulate),("collateral",StrictFuncon stepCollateral),("bind-recursively",PartiallyStrictFuncon [Strict,NonStrict] NonStrict stepBind_recursively),("recursive",PartiallyStrictFuncon [Strict,NonStrict] NonStrict stepRecursive),("re-close",PartiallyStrictFuncon [Strict,NonStrict] NonStrict stepRe_close),("bind-to-forward-links",StrictFuncon stepBind_to_forward_links),("set-forward-links",StrictFuncon stepSet_forward_links),("identifiers",NullaryFuncon stepIdentifiers),("ids",NullaryFuncon stepIdentifiers)]++environments_ = FName "environments"+env_ = FName "environments"+envs_ = FName "environments"+stepEnvironments = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "maps" [TName "identifiers",TName "values"]) env++identifier_tagged_ fargs = FApp "identifier-tagged" (fargs)+id_tagged_ fargs = FApp "identifier-tagged" (fargs)+stepIdentifier_tagged fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPMetaVar "_X1",VPMetaVar "_X2"] env+            env <- sideCondition (SCIsInSort (TVar "_X1") (TName "values")) env+            env <- sideCondition (SCIsInSort (TVar "_X2") (TName "values")) env+            rewriteTermTo (TApp "datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 'i'),FValue (Ascii 'd'),FValue (Ascii 'e'),FValue (Ascii 'n'),FValue (Ascii 't'),FValue (Ascii 'i'),FValue (Ascii 'f'),FValue (Ascii 'i'),FValue (Ascii 'e'),FValue (Ascii 'r'),FValue (Ascii '-'),FValue (Ascii 't'),FValue (Ascii 'a'),FValue (Ascii 'g'),FValue (Ascii 'g'),FValue (Ascii 'e'),FValue (Ascii 'd')])),TVar "_X1",TVar "_X2"]) env++fresh_identifier_ = FName "fresh-identifier"+stepFresh_identifier = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "identifier-tagged" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 'g'),FValue (Ascii 'e'),FValue (Ascii 'n'),FValue (Ascii 'e'),FValue (Ascii 'r'),FValue (Ascii 'a'),FValue (Ascii 't'),FValue (Ascii 'e'),FValue (Ascii 'd')])),TName "fresh-atom"]) env++initialise_binding_ fargs = FApp "initialise-binding" (fargs)+stepInitialise_binding fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "X"] env+            rewriteTermTo (TApp "initialise-linking" [TApp "initialise-generating" [TApp "closed" [TVar "X"]]]) env++bind_value_ fargs = FApp "bind-value" (fargs)+bind_ fargs = FApp "bind-value" (fargs)+stepBind_value fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "I") (TName "identifiers"),VPAnnotated (VPMetaVar "V") (TName "defined-values")] env+            rewriteTermTo (TMap [TVar "I",TVar "V"]) env++unbind_ fargs = FApp "unbind" (fargs)+stepUnbind fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "I") (TName "identifiers")] env+            rewriteTermTo (TMap [TVar "I",TName "none"]) env++bound_directly_ fargs = FApp "bound-directly" (fargs)+stepBound_directly fargs =+    evalRules [] [step1,step2]+    where step1 = do+            let env = emptyEnv+            env <- lifted_vsMatch fargs [VPAnnotated (VPMetaVar "I") (TName "identifiers")] env+            env <- getInhPatt "environment" (VPMetaVar "Rho") env+            env <- lifted_sideCondition (SCPatternMatch (TApp "lookup" [TVar "Rho",TVar "I"]) (VPAnnotated (VPMetaVar "V") (TName "defined-values"))) env+            stepTermTo (TVar "V") env+          step2 = do+            let env = emptyEnv+            env <- lifted_vsMatch fargs [VPAnnotated (VPMetaVar "I") (TName "identifiers")] env+            env <- getInhPatt "environment" (VPMetaVar "Rho") env+            env <- lifted_sideCondition (SCPatternMatch (TApp "lookup" [TVar "Rho",TVar "I"]) (PADT "none" [])) env+            stepTermTo (TName "fail") env++bound_value_ fargs = FApp "bound-value" (fargs)+bound_ fargs = FApp "bound-value" (fargs)+stepBound_value fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "I") (TName "identifiers")] env+            rewriteTermTo (TApp "follow-if-link" [TApp "bound-directly" [TVar "I"]]) env++closed_ fargs = FApp "closed" (fargs)+stepClosed fargs =+    evalRules [rewrite1] [step1]+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PAnnotated (PMetaVar "V") (TName "values")] env+            rewriteTermTo (TVar "V") env+          step1 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PMetaVar "X"] env+            env <- getInhPatt "environment" (VPWildCard) env+            env <- withInhTerm "environment" (TApp "map" []) env (premise (TVar "X") (PMetaVar "X'") env)+            stepTermTo (TApp "closed" [TVar "X'"]) env++scope_ fargs = FApp "scope" (fargs)+stepScope fargs =+    evalRules [rewrite1] [step1]+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PAnnotated PWildCard (TName "environments"),PAnnotated (PMetaVar "V") (TName "values")] env+            rewriteTermTo (TVar "V") env+          step1 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PAnnotated (PMetaVar "Rho1") (TName "environments"),PMetaVar "X"] env+            env <- getInhPatt "environment" (VPMetaVar "Rho0") env+            env <- withInhTerm "environment" (TApp "map-override" [TVar "Rho1",TVar "Rho0"]) env (premise (TVar "X") (PMetaVar "X'") env)+            stepTermTo (TApp "scope" [TVar "Rho1",TVar "X'"]) env++accumulate_ fargs = FApp "accumulate" (fargs)+stepAccumulate fargs =+    evalRules [rewrite1,rewrite2,rewrite3,rewrite4] [step1]+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PAnnotated (PMetaVar "Rho1") (TName "environments"),PMetaVar "D2"] env+            rewriteTermTo (TApp "scope" [TVar "Rho1",TApp "map-override" [TVar "D2",TVar "Rho1"]]) env+          rewrite2 = do+            let env = emptyEnv+            env <- fsMatch fargs [] env+            rewriteTermTo (TApp "map" []) env+          rewrite3 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "D1"] env+            rewriteTermTo (TVar "D1") env+          rewrite4 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "D1",PMetaVar "D2",PSeqVar "D+" PlusOp] env+            rewriteTermTo (TApp "accumulate" [TVar "D1",TApp "accumulate" [TVar "D2",TVar "D+"]]) env+          step1 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PMetaVar "D1",PMetaVar "D2"] env+            env <- premise (TVar "D1") (PMetaVar "D1'") env+            stepTermTo (TApp "accumulate" [TVar "D1'",TVar "D2"]) env++collateral_ fargs = FApp "collateral" (fargs)+stepCollateral fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPSeqVar "Rho*" StarOp) (TSortSeq (TName "environments") StarOp)] env+            rewriteTermTo (TApp "def" [TApp "map-unite" [TVar "Rho*"]]) env++bind_recursively_ fargs = FApp "bind-recursively" (fargs)+stepBind_recursively fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PAnnotated (PMetaVar "I") (TName "identifiers"),PMetaVar "E"] env+            rewriteTermTo (TApp "recursive" [TSet [TVar "I"],TApp "bind-value" [TVar "I",TVar "E"]]) env++recursive_ fargs = FApp "recursive" (fargs)+stepRecursive fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PAnnotated (PMetaVar "SI") (TApp "sets" [TName "identifiers"]),PMetaVar "D"] env+            rewriteTermTo (TApp "re-close" [TApp "bind-to-forward-links" [TVar "SI"],TVar "D"]) env++re_close_ fargs = FApp "re-close" (fargs)+stepRe_close fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PAnnotated (PMetaVar "M") (TApp "maps" [TName "identifiers",TName "links"]),PMetaVar "D"] env+            rewriteTermTo (TApp "accumulate" [TApp "scope" [TVar "M",TVar "D"],TApp "sequential" [TApp "set-forward-links" [TVar "M"],TApp "map" []]]) env++bind_to_forward_links_ fargs = FApp "bind-to-forward-links" (fargs)+stepBind_to_forward_links fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "SI") (TApp "sets" [TName "identifiers"])] env+            rewriteTermTo (TApp "map-unite" [TApp "interleave-map" [TApp "bind-value" [TName "given",TApp "fresh-link" [TName "defined-values"]],TApp "set-elements" [TVar "SI"]]]) env++set_forward_links_ fargs = FApp "set-forward-links" (fargs)+stepSet_forward_links fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "M") (TApp "maps" [TName "identifiers",TName "links"])] env+            rewriteTermTo (TApp "effect" [TApp "interleave-map" [TApp "set-link" [TApp "lookup" [TVar "M",TName "given"],TApp "bound-value" [TName "given"]],TApp "set-elements" [TApp "map-domain" [TVar "M"]]]]) env++identifiers_ = FName "identifiers"+stepIdentifiers = rewriteType "identifiers" []
+ cbs/Funcons/Core/Computations/Normal/Flowing/Flowing.hs view
@@ -0,0 +1,167 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Computations/Normal/Flowing/Flowing.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Computations.Normal.Flowing.Flowing where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    [("yielding",DataTypeMemberss "yielding" [] [DataTypeMemberConstructor "signal" [] (Just [])])]++funcons = libFromList+    [("interleave",StrictFuncon stepInterleave),("signal",NullaryFuncon stepSignal),("yield",NullaryFuncon stepYield),("yield-on-value",StrictFuncon stepYield_on_value),("yield-on-abrupt",NonStrictFuncon stepYield_on_abrupt),("left-to-right",NonStrictFuncon stepLeft_to_right),("l-to-r",NonStrictFuncon stepLeft_to_right),("right-to-left",NonStrictFuncon stepRight_to_left),("r-to-l",NonStrictFuncon stepRight_to_left),("sequential",NonStrictFuncon stepSequential),("seq",NonStrictFuncon stepSequential),("effect",StrictFuncon stepEffect),("choice",NonStrictFuncon stepChoice),("if-true-else",PartiallyStrictFuncon [Strict,NonStrict,NonStrict] NonStrict stepIf_true_else),("if-else",PartiallyStrictFuncon [Strict,NonStrict,NonStrict] NonStrict stepIf_true_else),("while-true",NonStrictFuncon stepWhile_true),("while",NonStrictFuncon stepWhile_true),("do-while-true",NonStrictFuncon stepDo_while_true),("do-while",NonStrictFuncon stepDo_while_true),("yielding",NullaryFuncon stepYielding)]++interleave_ fargs = FApp "interleave" (fargs)+stepInterleave fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)] env+            rewriteTermTo (TVar "V*") env++signal_ = FName "signal"+stepSignal = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 's'),FValue (Ascii 'i'),FValue (Ascii 'g'),FValue (Ascii 'n'),FValue (Ascii 'a'),FValue (Ascii 'l')]))]) env++yield_ = FName "yield"+stepYield = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "yield-on-value" [TName "none"]) env++yield_on_value_ fargs = FApp "yield-on-value" (fargs)+stepYield_on_value fargs =+    evalRules [] [step1]+    where step1 = do+            let env = emptyEnv+            env <- lifted_vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values")] env+            env <- getControlPatt "yielded" (Just (PADT "signal" [])) env+            raiseTerm "yielded" (TName "signal") env+            stepTermTo (TVar "V") env++yield_on_abrupt_ fargs = FApp "yield-on-abrupt" (fargs)+stepYield_on_abrupt fargs =+    evalRules [rewrite1] [step1,step2]+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PAnnotated (PMetaVar "V") (TName "values")] env+            rewriteTermTo (TVar "V") env+          step1 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PMetaVar "X"] env+            env <- getControlPatt "abrupt" (Just (VPMetaVar "V")) env+            env <- getControlPatt "yielded" (Just (PADT "signal" [])) env+            (env,[__varabrupt,__varyielded]) <- receiveSignals ["abrupt","yielded"] (withControlTerm "abrupt" (Just (TVar "V")) env (withControlTerm "yielded" (Just (TVar "___")) env (premise (TVar "X") (PMetaVar "X'") env)))+            env <- receiveSignalPatt __varabrupt (Just (VPAnnotated (VPMetaVar "V") (TName "values"))) env+            env <- receiveSignalPatt __varyielded (Just (VPSeqVar "___" QuestionMarkOp)) env+            raiseTerm "abrupt" (TVar "V") env+            raiseTerm "yielded" (TName "signal") env+            stepTermTo (TApp "yield-on-abrupt" [TVar "X'"]) env+          step2 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PMetaVar "X"] env+            env <- getControlPatt "abrupt" (Nothing) env+            (env,[__varabrupt]) <- receiveSignals ["abrupt"] (withControlTerm "abrupt" (Nothing) env (premise (TVar "X") (PMetaVar "X'") env))+            env <- receiveSignalPatt __varabrupt (Nothing) env+            stepTermTo (TApp "yield-on-abrupt" [TVar "X'"]) env++left_to_right_ fargs = FApp "left-to-right" (fargs)+l_to_r_ fargs = FApp "left-to-right" (fargs)+stepLeft_to_right fargs =+    evalRules [rewrite1] [step1]+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PAnnotated (PSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)] env+            rewriteTermTo (TVar "V*") env+          step1 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PAnnotated (PSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp),PMetaVar "Y",PSeqVar "Z*" StarOp] env+            env <- premise (TVar "Y") (PMetaVar "Y'") env+            stepTermTo (TApp "left-to-right" [TVar "V*",TVar "Y'",TVar "Z*"]) env++right_to_left_ fargs = FApp "right-to-left" (fargs)+r_to_l_ fargs = FApp "right-to-left" (fargs)+stepRight_to_left fargs =+    evalRules [rewrite1] [step1]+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PAnnotated (PSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)] env+            rewriteTermTo (TVar "V*") env+          step1 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PSeqVar "X*" StarOp,PMetaVar "Y",PAnnotated (PSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)] env+            env <- premise (TVar "Y") (PMetaVar "Y'") env+            stepTermTo (TApp "right-to-left" [TVar "X*",TVar "Y'",TVar "V*"]) env++sequential_ fargs = FApp "sequential" (fargs)+seq_ fargs = FApp "sequential" (fargs)+stepSequential fargs =+    evalRules [rewrite1,rewrite2] [step1]+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PValue (PADT "none" []),PSeqVar "Y+" PlusOp] env+            rewriteTermTo (TApp "sequential" [TVar "Y+"]) env+          rewrite2 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "Y"] env+            rewriteTermTo (TVar "Y") env+          step1 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PMetaVar "X",PSeqVar "Y+" PlusOp] env+            env <- premise (TVar "X") (PMetaVar "X'") env+            stepTermTo (TApp "sequential" [TVar "X'",TVar "Y+"]) env++effect_ fargs = FApp "effect" (fargs)+stepEffect fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)] env+            rewriteTermTo (TName "none") env++choice_ fargs = FApp "choice" (fargs)+stepChoice fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PSeqVar "X*" StarOp,PMetaVar "Y",PSeqVar "Z*" StarOp] env+            rewriteTermTo (TVar "Y") env++if_true_else_ fargs = FApp "if-true-else" (fargs)+if_else_ fargs = FApp "if-true-else" (fargs)+stepIf_true_else fargs =+    evalRules [rewrite1,rewrite2] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PValue (PADT "true" []),PMetaVar "X",PMetaVar "Y"] env+            rewriteTermTo (TVar "X") env+          rewrite2 = do+            let env = emptyEnv+            env <- fsMatch fargs [PValue (PADT "false" []),PMetaVar "X",PMetaVar "Y"] env+            rewriteTermTo (TVar "Y") env++while_true_ fargs = FApp "while-true" (fargs)+while_ fargs = FApp "while-true" (fargs)+stepWhile_true fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "B",PMetaVar "X"] env+            rewriteTermTo (TApp "if-true-else" [TVar "B",TApp "sequential" [TVar "X",TApp "while-true" [TVar "B",TVar "X"]],TName "none"]) env++do_while_true_ fargs = FApp "do-while-true" (fargs)+do_while_ fargs = FApp "do-while-true" (fargs)+stepDo_while_true fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "X",PMetaVar "B"] env+            rewriteTermTo (TApp "sequential" [TVar "X",TApp "if-true-else" [TVar "B",TApp "do-while-true" [TVar "X",TVar "B"],TName "none"]]) env++yielding_ = FName "yielding"+stepYielding = rewriteType "yielding" []
+ cbs/Funcons/Core/Computations/Normal/Generating/Generating.hs view
@@ -0,0 +1,35 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Computations/Normal/Generating/Generating.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Computations.Normal.Generating.Generating where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    []++funcons = libFromList+    [("fresh-atom",NullaryFuncon stepFresh_atom),("use-atom-not-in",StrictFuncon stepUse_atom_not_in)]++fresh_atom_ = FName "fresh-atom"+stepFresh_atom = evalRules [] [step1]+    where step1 = do+            let env = emptyEnv+            env <- getMutPatt "used-atom-set" (VPMetaVar "SA") env+            env <- lifted_sideCondition (SCPatternMatch (TApp "element-not-in" [TName "atoms",TVar "SA"]) (VPMetaVar "A")) env+            putMutTerm "used-atom-set" (TApp "set-insert" [TVar "A",TVar "SA"]) env+            stepTermTo (TVar "A") env++use_atom_not_in_ fargs = FApp "use-atom-not-in" (fargs)+stepUse_atom_not_in fargs =+    evalRules [] [step1]+    where step1 = do+            let env = emptyEnv+            env <- lifted_vsMatch fargs [VPAnnotated (VPMetaVar "SA") (TApp "sets" [TName "atoms"])] env+            env <- getMutPatt "used-atom-set" (VPMetaVar "SA'") env+            env <- lifted_sideCondition (SCPatternMatch (TApp "element-not-in" [TName "atoms",TVar "SA"]) (VPMetaVar "A")) env+            putMutTerm "used-atom-set" (TApp "set-insert" [TVar "A",TVar "SA'"]) env+            stepTermTo (TVar "A") env
+ cbs/Funcons/Core/Computations/Normal/Giving/Giving.hs view
@@ -0,0 +1,154 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Computations/Normal/Giving/Giving.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Computations.Normal.Giving.Giving where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    []++funcons = libFromList+    [("initialise-giving",NonStrictFuncon stepInitialise_giving),("give",PartiallyStrictFuncon [Strict,NonStrict] NonStrict stepGive),("given",NullaryFuncon stepGiven),("no-given",NonStrictFuncon stepNo_given),("left-to-right-map",PartiallyStrictFuncon [NonStrict] Strict stepLeft_to_right_map),("interleave-map",PartiallyStrictFuncon [NonStrict] Strict stepInterleave_map),("left-to-right-repeat",PartiallyStrictFuncon [NonStrict,Strict,Strict] NonStrict stepLeft_to_right_repeat),("interleave-repeat",PartiallyStrictFuncon [NonStrict,Strict,Strict] NonStrict stepInterleave_repeat),("left-to-right-filter",PartiallyStrictFuncon [NonStrict] Strict stepLeft_to_right_filter),("interleave-filter",PartiallyStrictFuncon [NonStrict] Strict stepInterleave_filter),("fold-left",PartiallyStrictFuncon [NonStrict,Strict] Strict stepFold_left),("fold-right",PartiallyStrictFuncon [NonStrict,Strict] Strict stepFold_right)]++initialise_giving_ fargs = FApp "initialise-giving" (fargs)+stepInitialise_giving fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "X"] env+            rewriteTermTo (TApp "no-given" [TVar "X"]) env++give_ fargs = FApp "give" (fargs)+stepGive fargs =+    evalRules [rewrite1] [step1]+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PAnnotated (PMetaVar "V") (TName "defined-values"),PAnnotated (PMetaVar "W") (TName "values")] env+            rewriteTermTo (TVar "W") env+          step1 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PAnnotated (PMetaVar "V") (TName "defined-values"),PMetaVar "Y"] env+            env <- getInhPatt "given-value" (VPWildCard) env+            env <- withInhTerm "given-value" (TVar "V") env (premise (TVar "Y") (PMetaVar "Y'") env)+            stepTermTo (TApp "give" [TVar "V",TVar "Y'"]) env++given_ = FName "given"+stepGiven = evalRules [] [step1,step2]+    where step1 = do+            let env = emptyEnv+            env <- getInhPatt "given-value" (VPAnnotated (VPMetaVar "V") (TName "defined-values")) env+            stepTermTo (TVar "V") env+          step2 = do+            let env = emptyEnv+            env <- getInhPatt "given-value" (PADT "none" []) env+            stepTermTo (TName "fail") env++no_given_ fargs = FApp "no-given" (fargs)+stepNo_given fargs =+    evalRules [rewrite1] [step1]+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PAnnotated (PMetaVar "U") (TName "values")] env+            rewriteTermTo (TVar "U") env+          step1 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PMetaVar "X"] env+            env <- getInhPatt "given-value" (VPWildCard) env+            env <- withInhTerm "given-value" (TName "none") env (premise (TVar "X") (PMetaVar "X'") env)+            stepTermTo (TApp "no-given" [TVar "X'"]) env++left_to_right_map_ fargs = FApp "left-to-right-map" (fargs)+stepLeft_to_right_map fargs =+    evalRules [rewrite1,rewrite2] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "F",PAnnotated (PMetaVar "V") (TName "defined-values"),PAnnotated (PSeqVar "V*" StarOp) (TSortSeq (TName "defined-values") StarOp)] env+            rewriteTermTo (TApp "left-to-right" [TApp "give" [TVar "V",TVar "F"],TApp "left-to-right-map" [TVar "F",TVar "V*"]]) env+          rewrite2 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "F"] env+            rewriteTermTo (TSeq []) env++interleave_map_ fargs = FApp "interleave-map" (fargs)+stepInterleave_map fargs =+    evalRules [rewrite1,rewrite2] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "F",PAnnotated (PMetaVar "V") (TName "defined-values"),PAnnotated (PSeqVar "V*" StarOp) (TSortSeq (TName "defined-values") StarOp)] env+            rewriteTermTo (TApp "interleave" [TApp "give" [TVar "V",TVar "F"],TApp "interleave-map" [TVar "F",TVar "V*"]]) env+          rewrite2 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "F"] env+            rewriteTermTo (TSeq []) env++left_to_right_repeat_ fargs = FApp "left-to-right-repeat" (fargs)+stepLeft_to_right_repeat fargs =+    evalRules [rewrite1,rewrite2] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "F",PAnnotated (PMetaVar "M") (TName "ints"),PAnnotated (PMetaVar "N") (TName "ints")] env+            env <- sideCondition (SCEquality (TApp "is-less-or-equal" [TVar "M",TVar "N"]) (TName "true")) env+            rewriteTermTo (TApp "left-to-right" [TApp "give" [TVar "M",TVar "F"],TApp "left-to-right-repeat" [TVar "F",TApp "int-add" [TVar "M",TFuncon (FValue (Nat 1))],TVar "N"]]) env+          rewrite2 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "F",PAnnotated (PMetaVar "M") (TName "ints"),PAnnotated (PMetaVar "N") (TName "ints")] env+            env <- sideCondition (SCEquality (TApp "is-less-or-equal" [TVar "M",TVar "N"]) (TName "false")) env+            rewriteTermTo (TSeq []) env++interleave_repeat_ fargs = FApp "interleave-repeat" (fargs)+stepInterleave_repeat fargs =+    evalRules [rewrite1,rewrite2] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "F",PAnnotated (PMetaVar "M") (TName "ints"),PAnnotated (PMetaVar "N") (TName "ints")] env+            env <- sideCondition (SCEquality (TApp "is-less-or-equal" [TVar "M",TVar "N"]) (TName "true")) env+            rewriteTermTo (TApp "interleave" [TApp "give" [TVar "M",TVar "F"],TApp "interleave-repeat" [TVar "F",TApp "int-add" [TVar "M",TFuncon (FValue (Nat 1))],TVar "N"]]) env+          rewrite2 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "F",PAnnotated (PMetaVar "M") (TName "ints"),PAnnotated (PMetaVar "N") (TName "ints")] env+            env <- sideCondition (SCEquality (TApp "is-less-or-equal" [TVar "M",TVar "N"]) (TName "false")) env+            rewriteTermTo (TSeq []) env++left_to_right_filter_ fargs = FApp "left-to-right-filter" (fargs)+stepLeft_to_right_filter fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "P",PAnnotated (PSeqVar "V*" StarOp) (TSortSeq (TName "defined-values") StarOp)] env+            rewriteTermTo (TApp "filter-defined" [TApp "left-to-right-map" [TApp "if-true-else" [TVar "P",TName "given",TName "none"],TVar "V*"]]) env++interleave_filter_ fargs = FApp "interleave-filter" (fargs)+stepInterleave_filter fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "P",PAnnotated (PSeqVar "V*" StarOp) (TSortSeq (TName "defined-values") StarOp)] env+            rewriteTermTo (TApp "filter-defined" [TApp "interleave-map" [TApp "if-true-else" [TVar "P",TName "given",TName "none"],TVar "V*"]]) env++fold_left_ fargs = FApp "fold-left" (fargs)+stepFold_left fargs =+    evalRules [rewrite1,rewrite2] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "F",PAnnotated (PMetaVar "A") (TName "values")] env+            rewriteTermTo (TVar "A") env+          rewrite2 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "F",PAnnotated (PMetaVar "A") (TName "values"),PAnnotated (PMetaVar "V") (TName "values"),PAnnotated (PSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)] env+            rewriteTermTo (TApp "fold-left" [TVar "F",TApp "give" [TApp "tuple" [TVar "A",TVar "V"],TVar "F"],TVar "V*"]) env++fold_right_ fargs = FApp "fold-right" (fargs)+stepFold_right fargs =+    evalRules [rewrite1,rewrite2] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PWildCard,PAnnotated (PMetaVar "A") (TName "values")] env+            rewriteTermTo (TVar "A") env+          rewrite2 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "F",PAnnotated (PMetaVar "A") (TName "values"),PAnnotated (PSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp),PAnnotated (PMetaVar "V") (TName "values")] env+            rewriteTermTo (TApp "give" [TApp "tuple" [TVar "V",TApp "fold-right" [TVar "F",TVar "A",TVar "V*"]],TVar "F"]) env
+ cbs/Funcons/Core/Computations/Normal/Interacting/Interacting.hs view
@@ -0,0 +1,35 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Computations/Normal/Interacting/Interacting.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Computations.Normal.Interacting.Interacting where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    []++funcons = libFromList+    [("print",StrictFuncon stepPrint),("read",NullaryFuncon stepRead)]++print_ fargs = FApp "print" (fargs)+stepPrint fargs =+    evalRules [] [step1]+    where step1 = do+            let env = emptyEnv+            env <- lifted_vsMatch fargs [VPAnnotated (VPSeqVar "V*" StarOp) (TSortSeq (TName "defined-values") StarOp)] env+            writeOutTerm "standard-out" (TVar "V*") env+            stepTermTo (TName "none") env++read_ = FName "read"+stepRead = evalRules [] [step1,step2]+    where step1 = do+            let env = emptyEnv+            env <- matchInput "standard-in" (VPAnnotated (VPMetaVar "V") (TName "defined-values")) env+            stepTermTo (TVar "V") env+          step2 = do+            let env = emptyEnv+            env <- matchInput "standard-in" (PADT "none" []) env+            stepTermTo (TName "fail") env
+ cbs/Funcons/Core/Computations/Normal/Linking/Linking.hs view
@@ -0,0 +1,81 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Computations/Normal/Linking/Linking.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Computations.Normal.Linking.Linking where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    [("links",DataTypeMemberss "links" [] [DataTypeMemberConstructor "link" [TName "variables"] (Just [])])]++funcons = libFromList+    [("link",StrictFuncon stepLink),("initialise-linking",NonStrictFuncon stepInitialise_linking),("fresh-link",NonStrictFuncon stepFresh_link),("fresh-initialised-link",PartiallyStrictFuncon [NonStrict,Strict] NonStrict stepFresh_initialised_link),("fresh-init-link",PartiallyStrictFuncon [NonStrict,Strict] NonStrict stepFresh_initialised_link),("set-link",StrictFuncon stepSet_link),("follow-link",StrictFuncon stepFollow_link),("follow-if-link",StrictFuncon stepFollow_if_link),("links",NullaryFuncon stepLinks)]++link_ fargs = FApp "link" (fargs)+stepLink fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPMetaVar "_X1"] env+            env <- sideCondition (SCIsInSort (TVar "_X1") (TName "values")) env+            rewriteTermTo (TApp "datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 'l'),FValue (Ascii 'i'),FValue (Ascii 'n'),FValue (Ascii 'k')])),TVar "_X1"]) env++initialise_linking_ fargs = FApp "initialise-linking" (fargs)+stepInitialise_linking fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "X"] env+            rewriteTermTo (TApp "initialise-storing" [TVar "X"]) env++fresh_link_ fargs = FApp "fresh-link" (fargs)+stepFresh_link fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "VT"] env+            rewriteTermTo (TApp "link" [TApp "allocate-variable" [TVar "VT"]]) env++fresh_initialised_link_ fargs = FApp "fresh-initialised-link" (fargs)+fresh_init_link_ fargs = FApp "fresh-initialised-link" (fargs)+stepFresh_initialised_link fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "VT",PAnnotated (PMetaVar "V") (TVar "VT")] env+            rewriteTermTo (TApp "link" [TApp "allocate-initialised-variable" [TVar "VT",TVar "V"]]) env++set_link_ fargs = FApp "set-link" (fargs)+stepSet_link fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "link" [VPAnnotated (VPMetaVar "Var") (TName "variables")],VPAnnotated (VPMetaVar "V") (TName "defined-values")] env+            rewriteTermTo (TApp "initialise-variable" [TVar "Var",TVar "V"]) env++follow_link_ fargs = FApp "follow-link" (fargs)+stepFollow_link fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "link" [VPAnnotated (VPMetaVar "Var") (TName "variables")]] env+            rewriteTermTo (TApp "assigned" [TVar "Var"]) env++follow_if_link_ fargs = FApp "follow-if-link" (fargs)+stepFollow_if_link fargs =+    evalRules [rewrite1,rewrite2] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "link" [VPAnnotated (VPMetaVar "Var") (TName "variables")]] env+            rewriteTermTo (TApp "assigned" [TVar "Var"]) env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPMetaVar "V"] env+            env <- sideCondition (SCIsInSort (TVar "V") (TSortComplement (TSortUnion (TName "links") (TName "nothing")))) env+            rewriteTermTo (TVar "V") env++links_ = FName "links"+stepLinks = rewriteType "links" []
+ cbs/Funcons/Core/Computations/Normal/Storing/Storing.hs view
@@ -0,0 +1,237 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Computations/Normal/Storing/Storing.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Computations.Normal.Storing.Storing where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    [("variables",DataTypeMemberss "variables" [] [DataTypeMemberConstructor "variable" [TName "locations",TName "value-types"] (Just [])]),("vars",DataTypeMemberss "vars" [] [DataTypeMemberConstructor "variable" [TName "locations",TName "value-types"] (Just [])])]++funcons = libFromList+    [("locations",NullaryFuncon stepLocations),("locs",NullaryFuncon stepLocations),("stores",NullaryFuncon stepStores),("store-clear",NullaryFuncon stepStore_clear),("initialise-storing",NonStrictFuncon stepInitialise_storing),("init-storing",NonStrictFuncon stepInitialise_storing),("variable",StrictFuncon stepVariable),("var",StrictFuncon stepVariable),("allocate-variable",NonStrictFuncon stepAllocate_variable),("alloc",NonStrictFuncon stepAllocate_variable),("recycle-variables",StrictFuncon stepRecycle_variables),("recycle",StrictFuncon stepRecycle_variables),("initialise-variable",StrictFuncon stepInitialise_variable),("init",StrictFuncon stepInitialise_variable),("allocate-initialised-variable",PartiallyStrictFuncon [NonStrict,Strict] NonStrict stepAllocate_initialised_variable),("alloc-init",PartiallyStrictFuncon [NonStrict,Strict] NonStrict stepAllocate_initialised_variable),("assign",StrictFuncon stepAssign),("assigned",StrictFuncon stepAssigned),("un-assign",StrictFuncon stepUn_assign),("structural-assign",StrictFuncon stepStructural_assign),("structural-assigned",StrictFuncon stepStructural_assigned),("current-value",StrictFuncon stepCurrent_value),("variables",NullaryFuncon stepVariables),("vars",NullaryFuncon stepVariables)]++locations_ = FName "locations"+locs_ = FName "locations"+stepLocations = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TName "atoms") env++stores_ = FName "stores"+stepStores = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "maps" [TName "locations",TName "values"]) env++store_clear_ = FName "store-clear"+stepStore_clear = evalRules [] [step1]+    where step1 = do+            let env = emptyEnv+            env <- getMutPatt "store" (VPWildCard) env+            putMutTerm "store" (TApp "map" []) env+            stepTermTo (TName "none") env++initialise_storing_ fargs = FApp "initialise-storing" (fargs)+init_storing_ fargs = FApp "initialise-storing" (fargs)+stepInitialise_storing fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "X"] env+            rewriteTermTo (TApp "sequential" [TName "store-clear",TApp "initialise-giving" [TApp "initialise-generating" [TVar "X"]]]) env++variable_ fargs = FApp "variable" (fargs)+var_ fargs = FApp "variable" (fargs)+stepVariable fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPMetaVar "_X1",VPMetaVar "_X2"] env+            env <- sideCondition (SCIsInSort (TVar "_X1") (TName "values")) env+            env <- sideCondition (SCIsInSort (TVar "_X2") (TName "values")) env+            rewriteTermTo (TApp "datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 'v'),FValue (Ascii 'a'),FValue (Ascii 'r'),FValue (Ascii 'i'),FValue (Ascii 'a'),FValue (Ascii 'b'),FValue (Ascii 'l'),FValue (Ascii 'e')])),TVar "_X1",TVar "_X2"]) env++allocate_variable_ fargs = FApp "allocate-variable" (fargs)+alloc_ fargs = FApp "allocate-variable" (fargs)+stepAllocate_variable fargs =+    evalRules [] [step1]+    where step1 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PAnnotated (PMetaVar "VT") (TName "types")] env+            env <- getMutPatt "store" (VPMetaVar "Sigma") env+            putMutTerm "store" (TVar "Sigma") env+            env <- premise (TApp "use-atom-not-in" [TApp "dom" [TVar "Sigma"]]) (PMetaVar "L") env+            env <- getMutPatt "store" (VPMetaVar "Sigma'") env+            env <- lifted_sideCondition (SCPatternMatch (TApp "map-override" [TMap [TVar "L",TName "none"],TVar "Sigma'"]) (VPMetaVar "Sigma''")) env+            putMutTerm "store" (TVar "Sigma''") env+            stepTermTo (TApp "variable" [TVar "L",TVar "VT"]) env++recycle_variables_ fargs = FApp "recycle-variables" (fargs)+recycle_ fargs = FApp "recycle-variables" (fargs)+stepRecycle_variables fargs =+    evalRules [rewrite1] [step1,step2]+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "Var") (TName "variables"),VPAnnotated (VPSeqVar "Var+" PlusOp) (TSortSeq (TName "variables") PlusOp)] env+            rewriteTermTo (TApp "sequential" [TApp "recycle-variables" [TVar "Var"],TApp "recycle-variables" [TVar "Var+"]]) env+          step1 = do+            let env = emptyEnv+            env <- lifted_vsMatch fargs [PADT "variable" [VPAnnotated (VPMetaVar "L") (TName "locations"),VPAnnotated (VPMetaVar "VT") (TName "types")]] env+            env <- getMutPatt "store" (VPMetaVar "Sigma") env+            env <- lifted_sideCondition (SCEquality (TApp "is-in-set" [TVar "L",TApp "dom" [TVar "Sigma"]]) (TName "true")) env+            putMutTerm "store" (TApp "map-delete" [TVar "Sigma",TSet [TVar "L"]]) env+            stepTermTo (TName "none") env+          step2 = do+            let env = emptyEnv+            env <- lifted_vsMatch fargs [PADT "variable" [VPAnnotated (VPMetaVar "L") (TName "locations"),VPAnnotated (VPMetaVar "VT") (TName "types")]] env+            env <- getMutPatt "store" (VPMetaVar "Sigma") env+            env <- lifted_sideCondition (SCEquality (TApp "is-in-set" [TVar "L",TApp "dom" [TVar "Sigma"]]) (TName "false")) env+            putMutTerm "store" (TVar "Sigma") env+            stepTermTo (TName "fail") env++initialise_variable_ fargs = FApp "initialise-variable" (fargs)+init_ fargs = FApp "initialise-variable" (fargs)+stepInitialise_variable fargs =+    evalRules [] [step1,step2]+    where step1 = do+            let env = emptyEnv+            env <- lifted_vsMatch fargs [PADT "variable" [VPAnnotated (VPMetaVar "L") (TName "locations"),VPAnnotated (VPMetaVar "VT") (TName "types")],VPAnnotated (VPMetaVar "Val") (TName "defined-values")] env+            env <- getMutPatt "store" (VPMetaVar "Sigma") env+            env <- lifted_sideCondition (SCEquality (TApp "and" [TApp "is-in-set" [TVar "L",TApp "dom" [TVar "Sigma"]],TApp "not" [TApp "is-defined" [TApp "lookup" [TVar "Sigma",TVar "L"]]],TApp "is-in-type" [TVar "Val",TVar "VT"]]) (TName "true")) env+            putMutTerm "store" (TApp "map-override" [TMap [TVar "L",TVar "Val"],TVar "Sigma"]) env+            stepTermTo (TName "none") env+          step2 = do+            let env = emptyEnv+            env <- lifted_vsMatch fargs [PADT "variable" [VPAnnotated (VPMetaVar "L") (TName "locations"),VPAnnotated (VPMetaVar "VT") (TName "types")],VPAnnotated (VPMetaVar "Val") (TName "defined-values")] env+            env <- getMutPatt "store" (VPMetaVar "Sigma") env+            env <- lifted_sideCondition (SCEquality (TApp "and" [TApp "is-in-set" [TVar "L",TApp "dom" [TVar "Sigma"]],TApp "not" [TApp "is-defined" [TApp "lookup" [TVar "Sigma",TVar "L"]]],TApp "is-in-type" [TVar "Val",TVar "VT"]]) (TName "false")) env+            putMutTerm "store" (TVar "Sigma") env+            stepTermTo (TName "fail") env++allocate_initialised_variable_ fargs = FApp "allocate-initialised-variable" (fargs)+alloc_init_ fargs = FApp "allocate-initialised-variable" (fargs)+stepAllocate_initialised_variable fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "VT",PAnnotated (PMetaVar "Val") (TVar "VT")] env+            rewriteTermTo (TApp "give" [TApp "allocate-variable" [TVar "VT"],TApp "sequential" [TApp "initialise-variable" [TName "given",TVar "Val"],TName "given"]]) env++assign_ fargs = FApp "assign" (fargs)+stepAssign fargs =+    evalRules [] [step1,step2]+    where step1 = do+            let env = emptyEnv+            env <- lifted_vsMatch fargs [PADT "variable" [VPAnnotated (VPMetaVar "L") (TName "locations"),VPAnnotated (VPMetaVar "VT") (TName "types")],VPAnnotated (VPMetaVar "Val") (TName "defined-values")] env+            env <- getMutPatt "store" (VPMetaVar "Sigma") env+            env <- lifted_sideCondition (SCEquality (TApp "and" [TApp "is-in-set" [TVar "L",TApp "dom" [TVar "Sigma"]],TApp "is-in-type" [TVar "Val",TVar "VT"]]) (TName "true")) env+            putMutTerm "store" (TApp "map-override" [TMap [TVar "L",TVar "Val"],TVar "Sigma"]) env+            stepTermTo (TName "none") env+          step2 = do+            let env = emptyEnv+            env <- lifted_vsMatch fargs [PADT "variable" [VPAnnotated (VPMetaVar "L") (TName "locations"),VPAnnotated (VPMetaVar "VT") (TName "types")],VPAnnotated (VPMetaVar "Val") (TName "defined-values")] env+            env <- getMutPatt "store" (VPMetaVar "Sigma") env+            env <- lifted_sideCondition (SCEquality (TApp "and" [TApp "is-in-set" [TVar "L",TApp "dom" [TVar "Sigma"]],TApp "is-in-type" [TVar "Val",TVar "VT"]]) (TName "false")) env+            putMutTerm "store" (TVar "Sigma") env+            stepTermTo (TName "fail") env++assigned_ fargs = FApp "assigned" (fargs)+stepAssigned fargs =+    evalRules [] [step1,step2]+    where step1 = do+            let env = emptyEnv+            env <- lifted_vsMatch fargs [PADT "variable" [VPAnnotated (VPMetaVar "L") (TName "locations"),VPAnnotated (VPMetaVar "VT") (TName "types")]] env+            env <- getMutPatt "store" (VPMetaVar "Sigma") env+            env <- lifted_sideCondition (SCPatternMatch (TApp "lookup" [TVar "Sigma",TVar "L"]) (VPAnnotated (VPMetaVar "Val") (TName "defined-values"))) env+            putMutTerm "store" (TVar "Sigma") env+            stepTermTo (TVar "Val") env+          step2 = do+            let env = emptyEnv+            env <- lifted_vsMatch fargs [PADT "variable" [VPAnnotated (VPMetaVar "L") (TName "locations"),VPAnnotated (VPMetaVar "VT") (TName "types")]] env+            env <- getMutPatt "store" (VPMetaVar "Sigma") env+            env <- lifted_sideCondition (SCEquality (TApp "lookup" [TVar "Sigma",TVar "L"]) (TName "none")) env+            putMutTerm "store" (TVar "Sigma") env+            stepTermTo (TName "fail") env++un_assign_ fargs = FApp "un-assign" (fargs)+stepUn_assign fargs =+    evalRules [] [step1,step2]+    where step1 = do+            let env = emptyEnv+            env <- lifted_vsMatch fargs [PADT "variable" [VPAnnotated (VPMetaVar "L") (TName "locations"),VPAnnotated (VPMetaVar "VT") (TName "types")]] env+            env <- getMutPatt "store" (VPMetaVar "Sigma") env+            env <- lifted_sideCondition (SCEquality (TApp "is-in-set" [TVar "L",TApp "dom" [TVar "Sigma"]]) (TName "true")) env+            putMutTerm "store" (TApp "map-override" [TMap [TVar "L",TName "none"],TVar "Sigma"]) env+            stepTermTo (TName "none") env+          step2 = do+            let env = emptyEnv+            env <- lifted_vsMatch fargs [PADT "variable" [VPAnnotated (VPMetaVar "L") (TName "locations"),VPAnnotated (VPMetaVar "VT") (TName "types")]] env+            env <- getMutPatt "store" (VPMetaVar "Sigma") env+            env <- lifted_sideCondition (SCEquality (TApp "is-in-set" [TVar "L",TApp "dom" [TVar "Sigma"]]) (TName "false")) env+            putMutTerm "store" (TVar "Sigma") env+            stepTermTo (TName "fail") env++structural_assign_ fargs = FApp "structural-assign" (fargs)+stepStructural_assign fargs =+    evalRules [rewrite1,rewrite2,rewrite3,rewrite4,rewrite5] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V1") (TName "variables"),VPAnnotated (VPMetaVar "V2") (TName "defined-values")] env+            rewriteTermTo (TApp "assign" [TVar "V1",TVar "V2"]) env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "datatype-value" [VPAnnotated (VPMetaVar "I1") (TName "ids"),VPAnnotated (VPSeqVar "V1*" StarOp) (TSortSeq (TName "defined-values") StarOp)],PADT "datatype-value" [VPAnnotated (VPMetaVar "I2") (TName "ids"),VPAnnotated (VPSeqVar "V2*" StarOp) (TSortSeq (TName "defined-values") StarOp)]] env+            env <- sideCondition (SCInequality (TVar "I1") (TFuncon (FValue (ADTVal "list" [FValue (Ascii 'v'),FValue (Ascii 'a'),FValue (Ascii 'r'),FValue (Ascii 'i'),FValue (Ascii 'a'),FValue (Ascii 'b'),FValue (Ascii 'l'),FValue (Ascii 'e')])))) env+            rewriteTermTo (TApp "sequential" [TApp "check-true" [TApp "is-equal" [TVar "I1",TVar "I2"]],TApp "effect" [TApp "tuple" [TApp "interleave-map" [TApp "structural-assign" [TApp "tuple-elements" [TName "given"]],TApp "tuple-zip" [TApp "tuple" [TVar "V1*"],TApp "tuple" [TVar "V2*"]]]]],TName "none"]) env+          rewrite3 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "M1") (TApp "maps" [TName "values",TName "values"]),VPAnnotated (VPMetaVar "M2") (TApp "maps" [TName "values",TName "values"])] env+            env <- sideCondition (SCEquality (TApp "dom" [TVar "M1"]) (TSet [])) env+            rewriteTermTo (TApp "check-true" [TApp "is-equal" [TApp "dom" [TVar "M2"],TSet []]]) env+          rewrite4 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "M1") (TApp "maps" [TName "values",TName "values"]),VPAnnotated (VPMetaVar "M2") (TApp "maps" [TName "values",TName "values"])] env+            env <- sideCondition (SCPatternMatch (TApp "some-element" [TApp "dom" [TVar "M1"]]) (VPMetaVar "K")) env+            rewriteTermTo (TApp "sequential" [TApp "check-true" [TApp "is-in-set" [TVar "K",TApp "dom" [TVar "M2"]]],TApp "structural-assign" [TApp "lookup" [TVar "M1",TVar "K"],TApp "lookup" [TVar "M2",TVar "K"]],TApp "structural-assign" [TApp "map-delete" [TVar "M1",TSet [TVar "K"]],TApp "map-delete" [TVar "M2",TSet [TVar "K"]]]]) env+          rewrite5 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V1") (TName "defined-values"),VPAnnotated (VPMetaVar "V2") (TName "defined-values")] env+            env <- sideCondition (SCIsInSort (TVar "V1") (TSortComplement (TSortUnion (TName "variables") (TApp "maps" [TName "values",TName "values"])))) env+            rewriteTermTo (TApp "check-true" [TApp "is-equal" [TVar "V1",TVar "V2"]]) env++structural_assigned_ fargs = FApp "structural-assigned" (fargs)+stepStructural_assigned fargs =+    evalRules [rewrite1,rewrite2,rewrite3,rewrite4] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "Var") (TName "variables")] env+            rewriteTermTo (TApp "assigned" [TVar "Var"]) env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "datatype-value" [VPAnnotated (VPMetaVar "I") (TName "ids"),VPAnnotated (VPSeqVar "V*" StarOp) (TSortSeq (TName "defined-values") StarOp)]] env+            env <- sideCondition (SCInequality (TVar "I") (TFuncon (FValue (ADTVal "list" [FValue (Ascii 'v'),FValue (Ascii 'a'),FValue (Ascii 'r'),FValue (Ascii 'i'),FValue (Ascii 'a'),FValue (Ascii 'b'),FValue (Ascii 'l'),FValue (Ascii 'e')])))) env+            rewriteTermTo (TApp "datatype-value" [TVar "I",TApp "interleave-map" [TApp "structural-assigned" [TName "given"],TVar "V*"]]) env+          rewrite3 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "M") (TApp "maps" [TName "values",TName "values"])] env+            rewriteTermTo (TApp "map" [TApp "interleave-map" [TApp "structural-assigned" [TName "given"],TApp "map-elements" [TVar "M"]]]) env+          rewrite4 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "U") (TName "values")] env+            env <- sideCondition (SCIsInSort (TVar "U") (TSortComplement (TSortUnion (TName "variables") (TApp "maps" [TName "values",TName "values"])))) env+            rewriteTermTo (TVar "U") env++current_value_ fargs = FApp "current-value" (fargs)+stepCurrent_value fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "defined-values")] env+            rewriteTermTo (TApp "def" [TApp "structural-assigned" [TVar "V"]]) env++variables_ = FName "variables"+stepVariables = rewriteType "variables" []
− cbs/Funcons/Core/Computations/Sorts.hs 
@@ -1,17 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Computations/sorts.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.Sorts where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("sorts",NullaryFuncon stepSorts)]--sorts_ = FName "sorts"-stepSorts = norule (FName "sorts")
cbs/Funcons/Core/Library.hs view
@@ -1,709 +1,247 @@ module Funcons.Core.Library (     funcons, entities, types,-   module Funcons.Core.Computations.Sorts,-   module Funcons.Core.Computations.ControlFlow.Normal.Sequencing.LeftToRight,-   module Funcons.Core.Computations.ControlFlow.Normal.Sequencing.Atomic,-   module Funcons.Core.Computations.ControlFlow.Normal.Sequencing.Sequential,-   module Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.VectorMap,-   module Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.SetMap,-   module Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.ListMap,-   module Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.TupleMap,-   module Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.MapMap,-   module Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.ListsMap,-   module Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.MultisetFilter,-   module Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.SetFilter,-   module Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.MapFilter,-   module Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.ListFilter,-   module Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.ReducingCollections.ListFoldl,-   module Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.ReducingCollections.ListFoldr,-   module Funcons.Core.Computations.ControlFlow.Normal.Iterating.Indefinite.While,-   module Funcons.Core.Computations.ControlFlow.Normal.Iterating.Indefinite.DoWhile,-   module Funcons.Core.Computations.ControlFlow.Normal.Choosing.IfThenElse,-   module Funcons.Core.Computations.ControlFlow.Abnormal.Stuck,-   module Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.Thrown,-   module Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.HandleThrown,-   module Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.Finally,-   module Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.Throw,-   module Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.HandleRecursively,-   module Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Plug,-   module Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.ResumeSignal,-   module Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Shift,-   module Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Prompt,-   module Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Control,-   module Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.CallCc,-   module Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Reset,-   module Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Hole,-   module Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Abort,-   module Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.ControlSignal,-   module Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Else,-   module Funcons.Core.Computations.ControlFlow.Abnormal.Failing.CheckTrue,-   module Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Fail,-   module Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Signals,-   module Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Dereference,-   module Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Failed,-   module Funcons.Core.Computations.DataFlow.Interacting.PrintList,-   module Funcons.Core.Computations.DataFlow.Interacting.Print,-   module Funcons.Core.Computations.DataFlow.Interacting.StandardOut,-   module Funcons.Core.Computations.DataFlow.Interacting.Read,-   module Funcons.Core.Computations.DataFlow.Interacting.StandardIn,-   module Funcons.Core.Computations.DataFlow.Effect,-   module Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.AllocateMap,-   module Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.GeneralAssign,-   module Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.GeneralAssigned,-   module Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.AllocateVector,-   module Funcons.Core.Computations.DataFlow.Storing.Stores,-   module Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.CurrentValue,-   module Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.Assigned,-   module Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.AllocateInitialisedVariable,-   module Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.AllocateVariable,-   module Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.DeallocateVariable,-   module Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.Assign,-   module Funcons.Core.Computations.DataFlow.Storing.Store,-   module Funcons.Core.Computations.DataFlow.Storing.Variables,-   module Funcons.Core.Computations.DataFlow.Linking.AllocateInitialisedLink,-   module Funcons.Core.Computations.DataFlow.Linking.AllocateLink,-   module Funcons.Core.Computations.DataFlow.Linking.FollowIfLink,-   module Funcons.Core.Computations.DataFlow.Linking.LinkStore,-   module Funcons.Core.Computations.DataFlow.Linking.Links,-   module Funcons.Core.Computations.DataFlow.Linking.FollowLink,-   module Funcons.Core.Computations.DataFlow.Linking.LinkStores,-   module Funcons.Core.Computations.DataFlow.Linking.SetLink,-   module Funcons.Core.Computations.DataFlow.Giving.Given,-   module Funcons.Core.Computations.DataFlow.Giving.Give,-   module Funcons.Core.Computations.DataFlow.Giving.GivenValue,-   module Funcons.Core.Computations.DataFlow.Generating.AtomGenerator,-   module Funcons.Core.Computations.DataFlow.Generating.FreshAtom,-   module Funcons.Core.Computations.DataFlow.Generating.FreshBinder,-   module Funcons.Core.Computations.DataFlow.Binding.Recursion.Recursive,-   module Funcons.Core.Computations.DataFlow.Binding.Recursion.BindRecursively,-   module Funcons.Core.Computations.DataFlow.Binding.Recursion.BoundRecursively,-   module Funcons.Core.Computations.DataFlow.Binding.Bound,-   module Funcons.Core.Computations.DataFlow.Binding.Environments,-   module Funcons.Core.Computations.DataFlow.Binding.Scope,-   module Funcons.Core.Computations.DataFlow.Binding.Accumulate,-   module Funcons.Core.Computations.DataFlow.Binding.Bind,-   module Funcons.Core.Computations.DataFlow.Binding.Environment,-   module Funcons.Core.Values.Types,-   module Funcons.Core.Values.CompositeValues.Collections.DirectedGraphs,-   module Funcons.Core.Values.CompositeValues.Collections.Tuples,-   module Funcons.Core.Values.CompositeValues.AlgebraicDatatypeValues.Variants,-   module Funcons.Core.Values.CompositeValues.AlgebraicDatatypeValues.Records,-   module Funcons.Core.Values.CompositeValues.AlgebraicDatatypeValues.References,-   module Funcons.Core.Values.PrimitiveValues.UnitType,-   module Funcons.Core.Values.PrimitiveValues.UnicodeCharacters,-   module Funcons.Core.Values.PrimitiveValues.Bits,-   module Funcons.Core.Values.PrimitiveValues.Strings,-   module Funcons.Core.Values.PrimitiveValues.Numbers.Integers,-   module Funcons.Core.Values.PrimitiveValues.Numbers.Rationals,-   module Funcons.Core.Values.PrimitiveValues.Numbers.IeeeFloats,-   module Funcons.Core.Values.PrimitiveValues.Booleans,-   module Funcons.Core.Abstractions.Closures.Close,-   module Funcons.Core.Abstractions.Closures.Closure,-   module Funcons.Core.Abstractions.Patterns.PatternPrefer,-   module Funcons.Core.Abstractions.Patterns.Match,-   module Funcons.Core.Abstractions.Patterns.Patterns,-   module Funcons.Core.Abstractions.Patterns.PatternUnite,-   module Funcons.Core.Abstractions.Patterns.PatternAny,-   module Funcons.Core.Abstractions.Patterns.Case,-   module Funcons.Core.Abstractions.Patterns.MatchLoosely,-   module Funcons.Core.Abstractions.Patterns.PatternBind,-   module Funcons.Core.Abstractions.IsGroundValue,-   module Funcons.Core.Abstractions.Functions.Apply,-   module Funcons.Core.Abstractions.Functions.Supply,-   module Funcons.Core.Abstractions.Functions.BindingLambda,-   module Funcons.Core.Abstractions.Functions.Curry,-   module Funcons.Core.Abstractions.Functions.Lambda,-   module Funcons.Core.Abstractions.Functions.Uncurry,-   module Funcons.Core.Abstractions.Functions.PartialApply,-   module Funcons.Core.Abstractions.Functions.Compose,-    ) where +   module Funcons.Core.Computations.Normal.Interacting.Interacting,+   module Funcons.Core.Computations.Normal.Flowing.Flowing,+   module Funcons.Core.Computations.Normal.Storing.Storing,+   module Funcons.Core.Computations.Normal.Linking.Linking,+   module Funcons.Core.Computations.Normal.Giving.Giving,+   module Funcons.Core.Computations.Normal.Generating.Generating,+   module Funcons.Core.Computations.Normal.Binding.Binding,+   module Funcons.Core.Computations.Abnormal.Abrupting.Abrupting,+   module Funcons.Core.Computations.Abnormal.Returning.Returning,+   module Funcons.Core.Computations.Abnormal.Throwing.Throwing,+   module Funcons.Core.Computations.Abnormal.Failing.Failing,+   module Funcons.Core.Computations.Abnormal.Sticking,+   module Funcons.Core.Computations.Abnormal.Breaking.Breaking,+   module Funcons.Core.Computations.Abnormal.Continuing.Continuing,+   module Funcons.Core.Computations.Abnormal.Controlling.Controlling,+   module Funcons.Core.Values.ValueTypes.ValueTypes,+--   module Funcons.Core.Values.Composite.Sets,+   module Funcons.Core.Values.Composite.Bits.Bits,+   module Funcons.Core.Values.Composite.Strings.Strings,+   module Funcons.Core.Values.Composite.Datatypes.Datatypes,+   module Funcons.Core.Values.Composite.Lists.Lists,+--   module Funcons.Core.Values.Composite.Multisets,+   module Funcons.Core.Values.Composite.Sequences.Sequences,+   module Funcons.Core.Values.Composite.Variants.Variants,+   module Funcons.Core.Values.Composite.Records.Records,+--   module Funcons.Core.Values.Composite.Maps,+   module Funcons.Core.Values.Composite.Vectors.Vectors,+   module Funcons.Core.Values.Composite.Tuples.Tuples,+   module Funcons.Core.Values.Composite.References.References,+   module Funcons.Core.Values.Composite.Graphs.Graphs,+   module Funcons.Core.Values.Primitive.Floats.Floats,+   module Funcons.Core.Values.Primitive.Integers.Integers,+   module Funcons.Core.Values.Primitive.Unit.Unit,+   module Funcons.Core.Values.Primitive.Booleans.Booleans,+   module Funcons.Core.Values.Primitive.Characters.Characters,+   module Funcons.Core.Values.Abstraction.Functions.Functions,+   module Funcons.Core.Values.Abstraction.Patterns.Patterns,+   module Funcons.Core.Values.Abstraction.Generic.Generic,+   module Funcons.Core.Values.Abstraction.Thunks.Thunks,+    ) where import Funcons.EDSL-import Funcons.Core.Computations.Sorts hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.Sorts-import Funcons.Core.Computations.ControlFlow.Normal.Sequencing.LeftToRight hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Normal.Sequencing.LeftToRight-import Funcons.Core.Computations.ControlFlow.Normal.Sequencing.Atomic hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Normal.Sequencing.Atomic-import Funcons.Core.Computations.ControlFlow.Normal.Sequencing.Sequential hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Normal.Sequencing.Sequential-import Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.VectorMap hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.VectorMap-import Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.SetMap hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.SetMap-import Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.ListMap hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.ListMap-import Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.TupleMap hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.TupleMap-import Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.MapMap hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.MapMap-import Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.ListsMap hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.ListsMap-import Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.MultisetFilter hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.MultisetFilter-import Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.SetFilter hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.SetFilter-import Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.MapFilter hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.MapFilter-import Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.ListFilter hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.ListFilter-import Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.ReducingCollections.ListFoldl hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.ReducingCollections.ListFoldl-import Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.ReducingCollections.ListFoldr hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.ReducingCollections.ListFoldr-import Funcons.Core.Computations.ControlFlow.Normal.Iterating.Indefinite.While hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Normal.Iterating.Indefinite.While-import Funcons.Core.Computations.ControlFlow.Normal.Iterating.Indefinite.DoWhile hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Normal.Iterating.Indefinite.DoWhile-import Funcons.Core.Computations.ControlFlow.Normal.Choosing.IfThenElse hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Normal.Choosing.IfThenElse-import Funcons.Core.Computations.ControlFlow.Abnormal.Stuck hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Abnormal.Stuck-import Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.Thrown hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.Thrown-import Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.HandleThrown hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.HandleThrown-import Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.Finally hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.Finally-import Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.Throw hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.Throw-import Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.HandleRecursively hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.HandleRecursively-import Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Plug hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Plug-import Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.ResumeSignal hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.ResumeSignal-import Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Shift hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Shift-import Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Prompt hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Prompt-import Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Control hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Control-import Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.CallCc hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.CallCc-import Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Reset hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Reset-import Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Hole hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Hole-import Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Abort hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Abort-import Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.ControlSignal hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.ControlSignal-import Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Else hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Else-import Funcons.Core.Computations.ControlFlow.Abnormal.Failing.CheckTrue hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Abnormal.Failing.CheckTrue-import Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Fail hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Fail-import Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Signals hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Signals-import Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Dereference hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Dereference-import Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Failed hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Failed-import Funcons.Core.Computations.DataFlow.Interacting.PrintList hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Interacting.PrintList-import Funcons.Core.Computations.DataFlow.Interacting.Print hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Interacting.Print-import Funcons.Core.Computations.DataFlow.Interacting.StandardOut hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Interacting.StandardOut-import Funcons.Core.Computations.DataFlow.Interacting.Read hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Interacting.Read-import Funcons.Core.Computations.DataFlow.Interacting.StandardIn hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Interacting.StandardIn-import Funcons.Core.Computations.DataFlow.Effect hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Effect-import Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.AllocateMap hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.AllocateMap-import Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.GeneralAssign hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.GeneralAssign-import Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.GeneralAssigned hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.GeneralAssigned-import Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.AllocateVector hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.AllocateVector-import Funcons.Core.Computations.DataFlow.Storing.Stores hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Storing.Stores-import Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.CurrentValue hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.CurrentValue-import Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.Assigned hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.Assigned-import Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.AllocateInitialisedVariable hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.AllocateInitialisedVariable-import Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.AllocateVariable hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.AllocateVariable-import Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.DeallocateVariable hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.DeallocateVariable-import Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.Assign hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.Assign-import Funcons.Core.Computations.DataFlow.Storing.Store hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Storing.Store-import Funcons.Core.Computations.DataFlow.Storing.Variables hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Storing.Variables-import Funcons.Core.Computations.DataFlow.Linking.AllocateInitialisedLink hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Linking.AllocateInitialisedLink-import Funcons.Core.Computations.DataFlow.Linking.AllocateLink hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Linking.AllocateLink-import Funcons.Core.Computations.DataFlow.Linking.FollowIfLink hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Linking.FollowIfLink-import Funcons.Core.Computations.DataFlow.Linking.LinkStore hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Linking.LinkStore-import Funcons.Core.Computations.DataFlow.Linking.Links hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Linking.Links-import Funcons.Core.Computations.DataFlow.Linking.FollowLink hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Linking.FollowLink-import Funcons.Core.Computations.DataFlow.Linking.LinkStores hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Linking.LinkStores-import Funcons.Core.Computations.DataFlow.Linking.SetLink hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Linking.SetLink-import Funcons.Core.Computations.DataFlow.Giving.Given hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Giving.Given-import Funcons.Core.Computations.DataFlow.Giving.Give hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Giving.Give-import Funcons.Core.Computations.DataFlow.Giving.GivenValue hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Giving.GivenValue-import Funcons.Core.Computations.DataFlow.Generating.AtomGenerator hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Generating.AtomGenerator-import Funcons.Core.Computations.DataFlow.Generating.FreshAtom hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Generating.FreshAtom-import Funcons.Core.Computations.DataFlow.Generating.FreshBinder hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Generating.FreshBinder-import Funcons.Core.Computations.DataFlow.Binding.Recursion.Recursive hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Binding.Recursion.Recursive-import Funcons.Core.Computations.DataFlow.Binding.Recursion.BindRecursively hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Binding.Recursion.BindRecursively-import Funcons.Core.Computations.DataFlow.Binding.Recursion.BoundRecursively hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Binding.Recursion.BoundRecursively-import Funcons.Core.Computations.DataFlow.Binding.Bound hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Binding.Bound-import Funcons.Core.Computations.DataFlow.Binding.Environments hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Binding.Environments-import Funcons.Core.Computations.DataFlow.Binding.Scope hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Binding.Scope-import Funcons.Core.Computations.DataFlow.Binding.Accumulate hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Binding.Accumulate-import Funcons.Core.Computations.DataFlow.Binding.Bind hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Binding.Bind-import Funcons.Core.Computations.DataFlow.Binding.Environment hiding (funcons,types,entities)-import qualified Funcons.Core.Computations.DataFlow.Binding.Environment-import Funcons.Core.Values.Types hiding (funcons,types,entities)-import qualified Funcons.Core.Values.Types-import Funcons.Core.Values.CompositeValues.Collections.DirectedGraphs hiding (funcons,types,entities)-import qualified Funcons.Core.Values.CompositeValues.Collections.DirectedGraphs-import Funcons.Core.Values.CompositeValues.Collections.Tuples hiding (funcons,types,entities)-import qualified Funcons.Core.Values.CompositeValues.Collections.Tuples-import Funcons.Core.Values.CompositeValues.AlgebraicDatatypeValues.Variants hiding (funcons,types,entities)-import qualified Funcons.Core.Values.CompositeValues.AlgebraicDatatypeValues.Variants-import Funcons.Core.Values.CompositeValues.AlgebraicDatatypeValues.Records hiding (funcons,types,entities)-import qualified Funcons.Core.Values.CompositeValues.AlgebraicDatatypeValues.Records-import Funcons.Core.Values.CompositeValues.AlgebraicDatatypeValues.References hiding (funcons,types,entities)-import qualified Funcons.Core.Values.CompositeValues.AlgebraicDatatypeValues.References-import Funcons.Core.Values.PrimitiveValues.UnitType hiding (funcons,types,entities)-import qualified Funcons.Core.Values.PrimitiveValues.UnitType-import Funcons.Core.Values.PrimitiveValues.UnicodeCharacters hiding (funcons,types,entities)-import qualified Funcons.Core.Values.PrimitiveValues.UnicodeCharacters-import Funcons.Core.Values.PrimitiveValues.Bits hiding (funcons,types,entities)-import qualified Funcons.Core.Values.PrimitiveValues.Bits-import Funcons.Core.Values.PrimitiveValues.Strings hiding (funcons,types,entities)-import qualified Funcons.Core.Values.PrimitiveValues.Strings-import Funcons.Core.Values.PrimitiveValues.Numbers.Integers hiding (funcons,types,entities)-import qualified Funcons.Core.Values.PrimitiveValues.Numbers.Integers-import Funcons.Core.Values.PrimitiveValues.Numbers.Rationals hiding (funcons,types,entities)-import qualified Funcons.Core.Values.PrimitiveValues.Numbers.Rationals-import Funcons.Core.Values.PrimitiveValues.Numbers.IeeeFloats hiding (funcons,types,entities)-import qualified Funcons.Core.Values.PrimitiveValues.Numbers.IeeeFloats-import Funcons.Core.Values.PrimitiveValues.Booleans hiding (funcons,types,entities)-import qualified Funcons.Core.Values.PrimitiveValues.Booleans-import Funcons.Core.Abstractions.Closures.Close hiding (funcons,types,entities)-import qualified Funcons.Core.Abstractions.Closures.Close-import Funcons.Core.Abstractions.Closures.Closure hiding (funcons,types,entities)-import qualified Funcons.Core.Abstractions.Closures.Closure-import Funcons.Core.Abstractions.Patterns.PatternPrefer hiding (funcons,types,entities)-import qualified Funcons.Core.Abstractions.Patterns.PatternPrefer-import Funcons.Core.Abstractions.Patterns.Match hiding (funcons,types,entities)-import qualified Funcons.Core.Abstractions.Patterns.Match-import Funcons.Core.Abstractions.Patterns.Patterns hiding (funcons,types,entities)-import qualified Funcons.Core.Abstractions.Patterns.Patterns-import Funcons.Core.Abstractions.Patterns.PatternUnite hiding (funcons,types,entities)-import qualified Funcons.Core.Abstractions.Patterns.PatternUnite-import Funcons.Core.Abstractions.Patterns.PatternAny hiding (funcons,types,entities)-import qualified Funcons.Core.Abstractions.Patterns.PatternAny-import Funcons.Core.Abstractions.Patterns.Case hiding (funcons,types,entities)-import qualified Funcons.Core.Abstractions.Patterns.Case-import Funcons.Core.Abstractions.Patterns.MatchLoosely hiding (funcons,types,entities)-import qualified Funcons.Core.Abstractions.Patterns.MatchLoosely-import Funcons.Core.Abstractions.Patterns.PatternBind hiding (funcons,types,entities)-import qualified Funcons.Core.Abstractions.Patterns.PatternBind-import Funcons.Core.Abstractions.IsGroundValue hiding (funcons,types,entities)-import qualified Funcons.Core.Abstractions.IsGroundValue-import Funcons.Core.Abstractions.Functions.Apply hiding (funcons,types,entities)-import qualified Funcons.Core.Abstractions.Functions.Apply-import Funcons.Core.Abstractions.Functions.Supply hiding (funcons,types,entities)-import qualified Funcons.Core.Abstractions.Functions.Supply-import Funcons.Core.Abstractions.Functions.BindingLambda hiding (funcons,types,entities)-import qualified Funcons.Core.Abstractions.Functions.BindingLambda-import Funcons.Core.Abstractions.Functions.Curry hiding (funcons,types,entities)-import qualified Funcons.Core.Abstractions.Functions.Curry-import Funcons.Core.Abstractions.Functions.Lambda hiding (funcons,types,entities)-import qualified Funcons.Core.Abstractions.Functions.Lambda-import Funcons.Core.Abstractions.Functions.Uncurry hiding (funcons,types,entities)-import qualified Funcons.Core.Abstractions.Functions.Uncurry-import Funcons.Core.Abstractions.Functions.PartialApply hiding (funcons,types,entities)-import qualified Funcons.Core.Abstractions.Functions.PartialApply-import Funcons.Core.Abstractions.Functions.Compose hiding (funcons,types,entities)-import qualified Funcons.Core.Abstractions.Functions.Compose+import Funcons.Core.Computations.Normal.Interacting.Interacting hiding (funcons,types,entities)+import qualified Funcons.Core.Computations.Normal.Interacting.Interacting+import Funcons.Core.Computations.Normal.Flowing.Flowing hiding (funcons,types,entities)+import qualified Funcons.Core.Computations.Normal.Flowing.Flowing+import Funcons.Core.Computations.Normal.Storing.Storing hiding (funcons,types,entities)+import qualified Funcons.Core.Computations.Normal.Storing.Storing+import Funcons.Core.Computations.Normal.Linking.Linking hiding (funcons,types,entities)+import qualified Funcons.Core.Computations.Normal.Linking.Linking+import Funcons.Core.Computations.Normal.Giving.Giving hiding (funcons,types,entities)+import qualified Funcons.Core.Computations.Normal.Giving.Giving+import Funcons.Core.Computations.Normal.Generating.Generating hiding (funcons,types,entities)+import qualified Funcons.Core.Computations.Normal.Generating.Generating+import Funcons.Core.Computations.Normal.Binding.Binding hiding (funcons,types,entities)+import qualified Funcons.Core.Computations.Normal.Binding.Binding+import Funcons.Core.Computations.Abnormal.Abrupting.Abrupting hiding (funcons,types,entities)+import qualified Funcons.Core.Computations.Abnormal.Abrupting.Abrupting+import Funcons.Core.Computations.Abnormal.Returning.Returning hiding (funcons,types,entities)+import qualified Funcons.Core.Computations.Abnormal.Returning.Returning+import Funcons.Core.Computations.Abnormal.Throwing.Throwing hiding (funcons,types,entities)+import qualified Funcons.Core.Computations.Abnormal.Throwing.Throwing+import Funcons.Core.Computations.Abnormal.Failing.Failing hiding (funcons,types,entities)+import qualified Funcons.Core.Computations.Abnormal.Failing.Failing+import Funcons.Core.Computations.Abnormal.Sticking hiding (funcons,types,entities)+import qualified Funcons.Core.Computations.Abnormal.Sticking+import Funcons.Core.Computations.Abnormal.Breaking.Breaking hiding (funcons,types,entities)+import qualified Funcons.Core.Computations.Abnormal.Breaking.Breaking+import Funcons.Core.Computations.Abnormal.Continuing.Continuing hiding (funcons,types,entities)+import qualified Funcons.Core.Computations.Abnormal.Continuing.Continuing+import Funcons.Core.Computations.Abnormal.Controlling.Controlling hiding (funcons,types,entities)+import qualified Funcons.Core.Computations.Abnormal.Controlling.Controlling+import Funcons.Core.Values.ValueTypes.ValueTypes hiding (funcons,types,entities)+import qualified Funcons.Core.Values.ValueTypes.ValueTypes+--import Funcons.Core.Values.Composite.Sets hiding (funcons,types,entities)+--import qualified Funcons.Core.Values.Composite.Sets+import Funcons.Core.Values.Composite.Bits.Bits hiding (funcons,types,entities)+import qualified Funcons.Core.Values.Composite.Bits.Bits+import Funcons.Core.Values.Composite.Strings.Strings hiding (funcons,types,entities)+import qualified Funcons.Core.Values.Composite.Strings.Strings+import Funcons.Core.Values.Composite.Datatypes.Datatypes hiding (funcons,types,entities)+import qualified Funcons.Core.Values.Composite.Datatypes.Datatypes+import Funcons.Core.Values.Composite.Lists.Lists hiding (funcons,types,entities)+import qualified Funcons.Core.Values.Composite.Lists.Lists+--import Funcons.Core.Values.Composite.Multisets hiding (funcons,types,entities)+--import qualified Funcons.Core.Values.Composite.Multisets+--import Funcons.Core.Values.Composite.Sequences.Sequences hiding (funcons,types,entities)+import qualified Funcons.Core.Values.Composite.Sequences.Sequences+import Funcons.Core.Values.Composite.Variants.Variants hiding (funcons,types,entities)+import qualified Funcons.Core.Values.Composite.Variants.Variants+import Funcons.Core.Values.Composite.Records.Records hiding (funcons,types,entities)+import qualified Funcons.Core.Values.Composite.Records.Records+--import Funcons.Core.Values.Composite.Maps hiding (funcons,types,entities)+--import qualified Funcons.Core.Values.Composite.Maps+import Funcons.Core.Values.Composite.Vectors.Vectors hiding (funcons,types,entities)+import qualified Funcons.Core.Values.Composite.Vectors.Vectors+import Funcons.Core.Values.Composite.Tuples.Tuples hiding (funcons,types,entities)+import qualified Funcons.Core.Values.Composite.Tuples.Tuples+import Funcons.Core.Values.Composite.References.References hiding (funcons,types,entities)+import qualified Funcons.Core.Values.Composite.References.References+import Funcons.Core.Values.Composite.Graphs.Graphs hiding (funcons,types,entities)+import qualified Funcons.Core.Values.Composite.Graphs.Graphs+import Funcons.Core.Values.Primitive.Floats.Floats hiding (funcons,types,entities)+import qualified Funcons.Core.Values.Primitive.Floats.Floats+import Funcons.Core.Values.Primitive.Integers.Integers hiding (funcons,types,entities)+import qualified Funcons.Core.Values.Primitive.Integers.Integers+import Funcons.Core.Values.Primitive.Unit.Unit hiding (funcons,types,entities)+import qualified Funcons.Core.Values.Primitive.Unit.Unit+import Funcons.Core.Values.Primitive.Booleans.Booleans hiding (funcons,types,entities)+import qualified Funcons.Core.Values.Primitive.Booleans.Booleans+import Funcons.Core.Values.Primitive.Characters.Characters hiding (funcons,types,entities)+import qualified Funcons.Core.Values.Primitive.Characters.Characters+import Funcons.Core.Values.Abstraction.Functions.Functions hiding (funcons,types,entities)+import qualified Funcons.Core.Values.Abstraction.Functions.Functions+import Funcons.Core.Values.Abstraction.Patterns.Patterns hiding (funcons,types,entities)+import qualified Funcons.Core.Values.Abstraction.Patterns.Patterns+import Funcons.Core.Values.Abstraction.Generic.Generic hiding (funcons,types,entities)+import qualified Funcons.Core.Values.Abstraction.Generic.Generic+import Funcons.Core.Values.Abstraction.Thunks.Thunks hiding (funcons,types,entities)+import qualified Funcons.Core.Values.Abstraction.Thunks.Thunks funcons = libUnions     [-     Funcons.Core.Computations.Sorts.funcons-    , Funcons.Core.Computations.ControlFlow.Normal.Sequencing.LeftToRight.funcons-    , Funcons.Core.Computations.ControlFlow.Normal.Sequencing.Atomic.funcons-    , Funcons.Core.Computations.ControlFlow.Normal.Sequencing.Sequential.funcons-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.VectorMap.funcons-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.SetMap.funcons-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.ListMap.funcons-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.TupleMap.funcons-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.MapMap.funcons-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.ListsMap.funcons-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.MultisetFilter.funcons-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.SetFilter.funcons-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.MapFilter.funcons-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.ListFilter.funcons-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.ReducingCollections.ListFoldl.funcons-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.ReducingCollections.ListFoldr.funcons-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Indefinite.While.funcons-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Indefinite.DoWhile.funcons-    , Funcons.Core.Computations.ControlFlow.Normal.Choosing.IfThenElse.funcons-    , Funcons.Core.Computations.ControlFlow.Abnormal.Stuck.funcons-    , Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.Thrown.funcons-    , Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.HandleThrown.funcons-    , Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.Finally.funcons-    , Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.Throw.funcons-    , Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.HandleRecursively.funcons-    , Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Plug.funcons-    , Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.ResumeSignal.funcons-    , Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Shift.funcons-    , Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Prompt.funcons-    , Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Control.funcons-    , Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.CallCc.funcons-    , Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Reset.funcons-    , Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Hole.funcons-    , Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Abort.funcons-    , Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.ControlSignal.funcons-    , Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Else.funcons-    , Funcons.Core.Computations.ControlFlow.Abnormal.Failing.CheckTrue.funcons-    , Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Fail.funcons-    , Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Signals.funcons-    , Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Dereference.funcons-    , Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Failed.funcons-    , Funcons.Core.Computations.DataFlow.Interacting.PrintList.funcons-    , Funcons.Core.Computations.DataFlow.Interacting.Print.funcons-    , Funcons.Core.Computations.DataFlow.Interacting.StandardOut.funcons-    , Funcons.Core.Computations.DataFlow.Interacting.Read.funcons-    , Funcons.Core.Computations.DataFlow.Interacting.StandardIn.funcons-    , Funcons.Core.Computations.DataFlow.Effect.funcons-    , Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.AllocateMap.funcons-    , Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.GeneralAssign.funcons-    , Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.GeneralAssigned.funcons-    , Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.AllocateVector.funcons-    , Funcons.Core.Computations.DataFlow.Storing.Stores.funcons-    , Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.CurrentValue.funcons-    , Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.Assigned.funcons-    , Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.AllocateInitialisedVariable.funcons-    , Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.AllocateVariable.funcons-    , Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.DeallocateVariable.funcons-    , Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.Assign.funcons-    , Funcons.Core.Computations.DataFlow.Storing.Store.funcons-    , Funcons.Core.Computations.DataFlow.Storing.Variables.funcons-    , Funcons.Core.Computations.DataFlow.Linking.AllocateInitialisedLink.funcons-    , Funcons.Core.Computations.DataFlow.Linking.AllocateLink.funcons-    , Funcons.Core.Computations.DataFlow.Linking.FollowIfLink.funcons-    , Funcons.Core.Computations.DataFlow.Linking.LinkStore.funcons-    , Funcons.Core.Computations.DataFlow.Linking.Links.funcons-    , Funcons.Core.Computations.DataFlow.Linking.FollowLink.funcons-    , Funcons.Core.Computations.DataFlow.Linking.LinkStores.funcons-    , Funcons.Core.Computations.DataFlow.Linking.SetLink.funcons-    , Funcons.Core.Computations.DataFlow.Giving.Given.funcons-    , Funcons.Core.Computations.DataFlow.Giving.Give.funcons-    , Funcons.Core.Computations.DataFlow.Giving.GivenValue.funcons-    , Funcons.Core.Computations.DataFlow.Generating.AtomGenerator.funcons-    , Funcons.Core.Computations.DataFlow.Generating.FreshAtom.funcons-    , Funcons.Core.Computations.DataFlow.Generating.FreshBinder.funcons-    , Funcons.Core.Computations.DataFlow.Binding.Recursion.Recursive.funcons-    , Funcons.Core.Computations.DataFlow.Binding.Recursion.BindRecursively.funcons-    , Funcons.Core.Computations.DataFlow.Binding.Recursion.BoundRecursively.funcons-    , Funcons.Core.Computations.DataFlow.Binding.Bound.funcons-    , Funcons.Core.Computations.DataFlow.Binding.Environments.funcons-    , Funcons.Core.Computations.DataFlow.Binding.Scope.funcons-    , Funcons.Core.Computations.DataFlow.Binding.Accumulate.funcons-    , Funcons.Core.Computations.DataFlow.Binding.Bind.funcons-    , Funcons.Core.Computations.DataFlow.Binding.Environment.funcons-    , Funcons.Core.Values.Types.funcons-    , Funcons.Core.Values.CompositeValues.Collections.DirectedGraphs.funcons-    , Funcons.Core.Values.CompositeValues.Collections.Tuples.funcons-    , Funcons.Core.Values.CompositeValues.AlgebraicDatatypeValues.Variants.funcons-    , Funcons.Core.Values.CompositeValues.AlgebraicDatatypeValues.Records.funcons-    , Funcons.Core.Values.CompositeValues.AlgebraicDatatypeValues.References.funcons-    , Funcons.Core.Values.PrimitiveValues.UnitType.funcons-    , Funcons.Core.Values.PrimitiveValues.UnicodeCharacters.funcons-    , Funcons.Core.Values.PrimitiveValues.Bits.funcons-    , Funcons.Core.Values.PrimitiveValues.Strings.funcons-    , Funcons.Core.Values.PrimitiveValues.Numbers.Integers.funcons-    , Funcons.Core.Values.PrimitiveValues.Numbers.Rationals.funcons-    , Funcons.Core.Values.PrimitiveValues.Numbers.IeeeFloats.funcons-    , Funcons.Core.Values.PrimitiveValues.Booleans.funcons-    , Funcons.Core.Abstractions.Closures.Close.funcons-    , Funcons.Core.Abstractions.Closures.Closure.funcons-    , Funcons.Core.Abstractions.Patterns.PatternPrefer.funcons-    , Funcons.Core.Abstractions.Patterns.Match.funcons-    , Funcons.Core.Abstractions.Patterns.Patterns.funcons-    , Funcons.Core.Abstractions.Patterns.PatternUnite.funcons-    , Funcons.Core.Abstractions.Patterns.PatternAny.funcons-    , Funcons.Core.Abstractions.Patterns.Case.funcons-    , Funcons.Core.Abstractions.Patterns.MatchLoosely.funcons-    , Funcons.Core.Abstractions.Patterns.PatternBind.funcons-    , Funcons.Core.Abstractions.IsGroundValue.funcons-    , Funcons.Core.Abstractions.Functions.Apply.funcons-    , Funcons.Core.Abstractions.Functions.Supply.funcons-    , Funcons.Core.Abstractions.Functions.BindingLambda.funcons-    , Funcons.Core.Abstractions.Functions.Curry.funcons-    , Funcons.Core.Abstractions.Functions.Lambda.funcons-    , Funcons.Core.Abstractions.Functions.Uncurry.funcons-    , Funcons.Core.Abstractions.Functions.PartialApply.funcons-    , Funcons.Core.Abstractions.Functions.Compose.funcons+     Funcons.Core.Computations.Normal.Interacting.Interacting.funcons+    , Funcons.Core.Computations.Normal.Flowing.Flowing.funcons+    , Funcons.Core.Computations.Normal.Storing.Storing.funcons+    , Funcons.Core.Computations.Normal.Linking.Linking.funcons+    , Funcons.Core.Computations.Normal.Giving.Giving.funcons+    , Funcons.Core.Computations.Normal.Generating.Generating.funcons+    , Funcons.Core.Computations.Normal.Binding.Binding.funcons+    , Funcons.Core.Computations.Abnormal.Abrupting.Abrupting.funcons+    , Funcons.Core.Computations.Abnormal.Returning.Returning.funcons+    , Funcons.Core.Computations.Abnormal.Throwing.Throwing.funcons+    , Funcons.Core.Computations.Abnormal.Failing.Failing.funcons+    , Funcons.Core.Computations.Abnormal.Sticking.funcons+    , Funcons.Core.Computations.Abnormal.Breaking.Breaking.funcons+    , Funcons.Core.Computations.Abnormal.Continuing.Continuing.funcons+    , Funcons.Core.Computations.Abnormal.Controlling.Controlling.funcons+    , Funcons.Core.Values.ValueTypes.ValueTypes.funcons+--    , Funcons.Core.Values.Composite.Sets.funcons+    , Funcons.Core.Values.Composite.Bits.Bits.funcons+    , Funcons.Core.Values.Composite.Strings.Strings.funcons+    , Funcons.Core.Values.Composite.Datatypes.Datatypes.funcons+    , Funcons.Core.Values.Composite.Lists.Lists.funcons+--    , Funcons.Core.Values.Composite.Multisets.funcons+    , Funcons.Core.Values.Composite.Sequences.Sequences.funcons+    , Funcons.Core.Values.Composite.Variants.Variants.funcons+    , Funcons.Core.Values.Composite.Records.Records.funcons+--    , Funcons.Core.Values.Composite.Maps.funcons+    , Funcons.Core.Values.Composite.Vectors.Vectors.funcons+    , Funcons.Core.Values.Composite.Tuples.Tuples.funcons+    , Funcons.Core.Values.Composite.References.References.funcons+    , Funcons.Core.Values.Composite.Graphs.Graphs.funcons+    , Funcons.Core.Values.Primitive.Floats.Floats.funcons+    , Funcons.Core.Values.Primitive.Integers.Integers.funcons+    , Funcons.Core.Values.Primitive.Unit.Unit.funcons+    , Funcons.Core.Values.Primitive.Booleans.Booleans.funcons+    , Funcons.Core.Values.Primitive.Characters.Characters.funcons+    , Funcons.Core.Values.Abstraction.Functions.Functions.funcons+    , Funcons.Core.Values.Abstraction.Patterns.Patterns.funcons+    , Funcons.Core.Values.Abstraction.Generic.Generic.funcons+    , Funcons.Core.Values.Abstraction.Thunks.Thunks.funcons     ]-entities = concat +entities = concat     [-     Funcons.Core.Computations.Sorts.entities-    , Funcons.Core.Computations.ControlFlow.Normal.Sequencing.LeftToRight.entities-    , Funcons.Core.Computations.ControlFlow.Normal.Sequencing.Atomic.entities-    , Funcons.Core.Computations.ControlFlow.Normal.Sequencing.Sequential.entities-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.VectorMap.entities-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.SetMap.entities-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.ListMap.entities-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.TupleMap.entities-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.MapMap.entities-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.ListsMap.entities-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.MultisetFilter.entities-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.SetFilter.entities-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.MapFilter.entities-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.ListFilter.entities-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.ReducingCollections.ListFoldl.entities-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.ReducingCollections.ListFoldr.entities-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Indefinite.While.entities-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Indefinite.DoWhile.entities-    , Funcons.Core.Computations.ControlFlow.Normal.Choosing.IfThenElse.entities-    , Funcons.Core.Computations.ControlFlow.Abnormal.Stuck.entities-    , Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.Thrown.entities-    , Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.HandleThrown.entities-    , Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.Finally.entities-    , Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.Throw.entities-    , Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.HandleRecursively.entities-    , Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Plug.entities-    , Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.ResumeSignal.entities-    , Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Shift.entities-    , Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Prompt.entities-    , Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Control.entities-    , Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.CallCc.entities-    , Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Reset.entities-    , Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Hole.entities-    , Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Abort.entities-    , Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.ControlSignal.entities-    , Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Else.entities-    , Funcons.Core.Computations.ControlFlow.Abnormal.Failing.CheckTrue.entities-    , Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Fail.entities-    , Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Signals.entities-    , Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Dereference.entities-    , Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Failed.entities-    , Funcons.Core.Computations.DataFlow.Interacting.PrintList.entities-    , Funcons.Core.Computations.DataFlow.Interacting.Print.entities-    , Funcons.Core.Computations.DataFlow.Interacting.StandardOut.entities-    , Funcons.Core.Computations.DataFlow.Interacting.Read.entities-    , Funcons.Core.Computations.DataFlow.Interacting.StandardIn.entities-    , Funcons.Core.Computations.DataFlow.Effect.entities-    , Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.AllocateMap.entities-    , Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.GeneralAssign.entities-    , Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.GeneralAssigned.entities-    , Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.AllocateVector.entities-    , Funcons.Core.Computations.DataFlow.Storing.Stores.entities-    , Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.CurrentValue.entities-    , Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.Assigned.entities-    , Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.AllocateInitialisedVariable.entities-    , Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.AllocateVariable.entities-    , Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.DeallocateVariable.entities-    , Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.Assign.entities-    , Funcons.Core.Computations.DataFlow.Storing.Store.entities-    , Funcons.Core.Computations.DataFlow.Storing.Variables.entities-    , Funcons.Core.Computations.DataFlow.Linking.AllocateInitialisedLink.entities-    , Funcons.Core.Computations.DataFlow.Linking.AllocateLink.entities-    , Funcons.Core.Computations.DataFlow.Linking.FollowIfLink.entities-    , Funcons.Core.Computations.DataFlow.Linking.LinkStore.entities-    , Funcons.Core.Computations.DataFlow.Linking.Links.entities-    , Funcons.Core.Computations.DataFlow.Linking.FollowLink.entities-    , Funcons.Core.Computations.DataFlow.Linking.LinkStores.entities-    , Funcons.Core.Computations.DataFlow.Linking.SetLink.entities-    , Funcons.Core.Computations.DataFlow.Giving.Given.entities-    , Funcons.Core.Computations.DataFlow.Giving.Give.entities-    , Funcons.Core.Computations.DataFlow.Giving.GivenValue.entities-    , Funcons.Core.Computations.DataFlow.Generating.AtomGenerator.entities-    , Funcons.Core.Computations.DataFlow.Generating.FreshAtom.entities-    , Funcons.Core.Computations.DataFlow.Generating.FreshBinder.entities-    , Funcons.Core.Computations.DataFlow.Binding.Recursion.Recursive.entities-    , Funcons.Core.Computations.DataFlow.Binding.Recursion.BindRecursively.entities-    , Funcons.Core.Computations.DataFlow.Binding.Recursion.BoundRecursively.entities-    , Funcons.Core.Computations.DataFlow.Binding.Bound.entities-    , Funcons.Core.Computations.DataFlow.Binding.Environments.entities-    , Funcons.Core.Computations.DataFlow.Binding.Scope.entities-    , Funcons.Core.Computations.DataFlow.Binding.Accumulate.entities-    , Funcons.Core.Computations.DataFlow.Binding.Bind.entities-    , Funcons.Core.Computations.DataFlow.Binding.Environment.entities-    , Funcons.Core.Values.Types.entities-    , Funcons.Core.Values.CompositeValues.Collections.DirectedGraphs.entities-    , Funcons.Core.Values.CompositeValues.Collections.Tuples.entities-    , Funcons.Core.Values.CompositeValues.AlgebraicDatatypeValues.Variants.entities-    , Funcons.Core.Values.CompositeValues.AlgebraicDatatypeValues.Records.entities-    , Funcons.Core.Values.CompositeValues.AlgebraicDatatypeValues.References.entities-    , Funcons.Core.Values.PrimitiveValues.UnitType.entities-    , Funcons.Core.Values.PrimitiveValues.UnicodeCharacters.entities-    , Funcons.Core.Values.PrimitiveValues.Bits.entities-    , Funcons.Core.Values.PrimitiveValues.Strings.entities-    , Funcons.Core.Values.PrimitiveValues.Numbers.Integers.entities-    , Funcons.Core.Values.PrimitiveValues.Numbers.Rationals.entities-    , Funcons.Core.Values.PrimitiveValues.Numbers.IeeeFloats.entities-    , Funcons.Core.Values.PrimitiveValues.Booleans.entities-    , Funcons.Core.Abstractions.Closures.Close.entities-    , Funcons.Core.Abstractions.Closures.Closure.entities-    , Funcons.Core.Abstractions.Patterns.PatternPrefer.entities-    , Funcons.Core.Abstractions.Patterns.Match.entities-    , Funcons.Core.Abstractions.Patterns.Patterns.entities-    , Funcons.Core.Abstractions.Patterns.PatternUnite.entities-    , Funcons.Core.Abstractions.Patterns.PatternAny.entities-    , Funcons.Core.Abstractions.Patterns.Case.entities-    , Funcons.Core.Abstractions.Patterns.MatchLoosely.entities-    , Funcons.Core.Abstractions.Patterns.PatternBind.entities-    , Funcons.Core.Abstractions.IsGroundValue.entities-    , Funcons.Core.Abstractions.Functions.Apply.entities-    , Funcons.Core.Abstractions.Functions.Supply.entities-    , Funcons.Core.Abstractions.Functions.BindingLambda.entities-    , Funcons.Core.Abstractions.Functions.Curry.entities-    , Funcons.Core.Abstractions.Functions.Lambda.entities-    , Funcons.Core.Abstractions.Functions.Uncurry.entities-    , Funcons.Core.Abstractions.Functions.PartialApply.entities-    , Funcons.Core.Abstractions.Functions.Compose.entities+     Funcons.Core.Computations.Normal.Interacting.Interacting.entities+    , Funcons.Core.Computations.Normal.Flowing.Flowing.entities+    , Funcons.Core.Computations.Normal.Storing.Storing.entities+    , Funcons.Core.Computations.Normal.Linking.Linking.entities+    , Funcons.Core.Computations.Normal.Giving.Giving.entities+    , Funcons.Core.Computations.Normal.Generating.Generating.entities+    , Funcons.Core.Computations.Normal.Binding.Binding.entities+    , Funcons.Core.Computations.Abnormal.Abrupting.Abrupting.entities+    , Funcons.Core.Computations.Abnormal.Returning.Returning.entities+    , Funcons.Core.Computations.Abnormal.Throwing.Throwing.entities+    , Funcons.Core.Computations.Abnormal.Failing.Failing.entities+    , Funcons.Core.Computations.Abnormal.Sticking.entities+    , Funcons.Core.Computations.Abnormal.Breaking.Breaking.entities+    , Funcons.Core.Computations.Abnormal.Continuing.Continuing.entities+    , Funcons.Core.Computations.Abnormal.Controlling.Controlling.entities+    , Funcons.Core.Values.ValueTypes.ValueTypes.entities+--    , Funcons.Core.Values.Composite.Sets.entities+    , Funcons.Core.Values.Composite.Bits.Bits.entities+    , Funcons.Core.Values.Composite.Strings.Strings.entities+    , Funcons.Core.Values.Composite.Datatypes.Datatypes.entities+    , Funcons.Core.Values.Composite.Lists.Lists.entities+--    , Funcons.Core.Values.Composite.Multisets.entities+    , Funcons.Core.Values.Composite.Sequences.Sequences.entities+    , Funcons.Core.Values.Composite.Variants.Variants.entities+    , Funcons.Core.Values.Composite.Records.Records.entities+--    , Funcons.Core.Values.Composite.Maps.entities+    , Funcons.Core.Values.Composite.Vectors.Vectors.entities+    , Funcons.Core.Values.Composite.Tuples.Tuples.entities+    , Funcons.Core.Values.Composite.References.References.entities+    , Funcons.Core.Values.Composite.Graphs.Graphs.entities+    , Funcons.Core.Values.Primitive.Floats.Floats.entities+    , Funcons.Core.Values.Primitive.Integers.Integers.entities+    , Funcons.Core.Values.Primitive.Unit.Unit.entities+    , Funcons.Core.Values.Primitive.Booleans.Booleans.entities+    , Funcons.Core.Values.Primitive.Characters.Characters.entities+    , Funcons.Core.Values.Abstraction.Functions.Functions.entities+    , Funcons.Core.Values.Abstraction.Patterns.Patterns.entities+    , Funcons.Core.Values.Abstraction.Generic.Generic.entities+    , Funcons.Core.Values.Abstraction.Thunks.Thunks.entities     ]-types = typeEnvUnions +types = typeEnvUnions     [-     Funcons.Core.Computations.Sorts.types-    , Funcons.Core.Computations.ControlFlow.Normal.Sequencing.LeftToRight.types-    , Funcons.Core.Computations.ControlFlow.Normal.Sequencing.Atomic.types-    , Funcons.Core.Computations.ControlFlow.Normal.Sequencing.Sequential.types-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.VectorMap.types-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.SetMap.types-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.ListMap.types-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.TupleMap.types-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.MapMap.types-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.ListsMap.types-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.MultisetFilter.types-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.SetFilter.types-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.MapFilter.types-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.ListFilter.types-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.ReducingCollections.ListFoldl.types-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.ReducingCollections.ListFoldr.types-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Indefinite.While.types-    , Funcons.Core.Computations.ControlFlow.Normal.Iterating.Indefinite.DoWhile.types-    , Funcons.Core.Computations.ControlFlow.Normal.Choosing.IfThenElse.types-    , Funcons.Core.Computations.ControlFlow.Abnormal.Stuck.types-    , Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.Thrown.types-    , Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.HandleThrown.types-    , Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.Finally.types-    , Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.Throw.types-    , Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.HandleRecursively.types-    , Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Plug.types-    , Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.ResumeSignal.types-    , Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Shift.types-    , Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Prompt.types-    , Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Control.types-    , Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.CallCc.types-    , Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Reset.types-    , Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Hole.types-    , Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Abort.types-    , Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.ControlSignal.types-    , Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Else.types-    , Funcons.Core.Computations.ControlFlow.Abnormal.Failing.CheckTrue.types-    , Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Fail.types-    , Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Signals.types-    , Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Dereference.types-    , Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Failed.types-    , Funcons.Core.Computations.DataFlow.Interacting.PrintList.types-    , Funcons.Core.Computations.DataFlow.Interacting.Print.types-    , Funcons.Core.Computations.DataFlow.Interacting.StandardOut.types-    , Funcons.Core.Computations.DataFlow.Interacting.Read.types-    , Funcons.Core.Computations.DataFlow.Interacting.StandardIn.types-    , Funcons.Core.Computations.DataFlow.Effect.types-    , Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.AllocateMap.types-    , Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.GeneralAssign.types-    , Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.GeneralAssigned.types-    , Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.AllocateVector.types-    , Funcons.Core.Computations.DataFlow.Storing.Stores.types-    , Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.CurrentValue.types-    , Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.Assigned.types-    , Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.AllocateInitialisedVariable.types-    , Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.AllocateVariable.types-    , Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.DeallocateVariable.types-    , Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.Assign.types-    , Funcons.Core.Computations.DataFlow.Storing.Store.types-    , Funcons.Core.Computations.DataFlow.Storing.Variables.types-    , Funcons.Core.Computations.DataFlow.Linking.AllocateInitialisedLink.types-    , Funcons.Core.Computations.DataFlow.Linking.AllocateLink.types-    , Funcons.Core.Computations.DataFlow.Linking.FollowIfLink.types-    , Funcons.Core.Computations.DataFlow.Linking.LinkStore.types-    , Funcons.Core.Computations.DataFlow.Linking.Links.types-    , Funcons.Core.Computations.DataFlow.Linking.FollowLink.types-    , Funcons.Core.Computations.DataFlow.Linking.LinkStores.types-    , Funcons.Core.Computations.DataFlow.Linking.SetLink.types-    , Funcons.Core.Computations.DataFlow.Giving.Given.types-    , Funcons.Core.Computations.DataFlow.Giving.Give.types-    , Funcons.Core.Computations.DataFlow.Giving.GivenValue.types-    , Funcons.Core.Computations.DataFlow.Generating.AtomGenerator.types-    , Funcons.Core.Computations.DataFlow.Generating.FreshAtom.types-    , Funcons.Core.Computations.DataFlow.Generating.FreshBinder.types-    , Funcons.Core.Computations.DataFlow.Binding.Recursion.Recursive.types-    , Funcons.Core.Computations.DataFlow.Binding.Recursion.BindRecursively.types-    , Funcons.Core.Computations.DataFlow.Binding.Recursion.BoundRecursively.types-    , Funcons.Core.Computations.DataFlow.Binding.Bound.types-    , Funcons.Core.Computations.DataFlow.Binding.Environments.types-    , Funcons.Core.Computations.DataFlow.Binding.Scope.types-    , Funcons.Core.Computations.DataFlow.Binding.Accumulate.types-    , Funcons.Core.Computations.DataFlow.Binding.Bind.types-    , Funcons.Core.Computations.DataFlow.Binding.Environment.types-    , Funcons.Core.Values.Types.types-    , Funcons.Core.Values.CompositeValues.Collections.DirectedGraphs.types-    , Funcons.Core.Values.CompositeValues.Collections.Tuples.types-    , Funcons.Core.Values.CompositeValues.AlgebraicDatatypeValues.Variants.types-    , Funcons.Core.Values.CompositeValues.AlgebraicDatatypeValues.Records.types-    , Funcons.Core.Values.CompositeValues.AlgebraicDatatypeValues.References.types-    , Funcons.Core.Values.PrimitiveValues.UnitType.types-    , Funcons.Core.Values.PrimitiveValues.UnicodeCharacters.types-    , Funcons.Core.Values.PrimitiveValues.Bits.types-    , Funcons.Core.Values.PrimitiveValues.Strings.types-    , Funcons.Core.Values.PrimitiveValues.Numbers.Integers.types-    , Funcons.Core.Values.PrimitiveValues.Numbers.Rationals.types-    , Funcons.Core.Values.PrimitiveValues.Numbers.IeeeFloats.types-    , Funcons.Core.Values.PrimitiveValues.Booleans.types-    , Funcons.Core.Abstractions.Closures.Close.types-    , Funcons.Core.Abstractions.Closures.Closure.types-    , Funcons.Core.Abstractions.Patterns.PatternPrefer.types-    , Funcons.Core.Abstractions.Patterns.Match.types-    , Funcons.Core.Abstractions.Patterns.Patterns.types-    , Funcons.Core.Abstractions.Patterns.PatternUnite.types-    , Funcons.Core.Abstractions.Patterns.PatternAny.types-    , Funcons.Core.Abstractions.Patterns.Case.types-    , Funcons.Core.Abstractions.Patterns.MatchLoosely.types-    , Funcons.Core.Abstractions.Patterns.PatternBind.types-    , Funcons.Core.Abstractions.IsGroundValue.types-    , Funcons.Core.Abstractions.Functions.Apply.types-    , Funcons.Core.Abstractions.Functions.Supply.types-    , Funcons.Core.Abstractions.Functions.BindingLambda.types-    , Funcons.Core.Abstractions.Functions.Curry.types-    , Funcons.Core.Abstractions.Functions.Lambda.types-    , Funcons.Core.Abstractions.Functions.Uncurry.types-    , Funcons.Core.Abstractions.Functions.PartialApply.types-    , Funcons.Core.Abstractions.Functions.Compose.types+     Funcons.Core.Computations.Normal.Interacting.Interacting.types+    , Funcons.Core.Computations.Normal.Flowing.Flowing.types+    , Funcons.Core.Computations.Normal.Storing.Storing.types+    , Funcons.Core.Computations.Normal.Linking.Linking.types+    , Funcons.Core.Computations.Normal.Giving.Giving.types+    , Funcons.Core.Computations.Normal.Generating.Generating.types+    , Funcons.Core.Computations.Normal.Binding.Binding.types+    , Funcons.Core.Computations.Abnormal.Abrupting.Abrupting.types+    , Funcons.Core.Computations.Abnormal.Returning.Returning.types+    , Funcons.Core.Computations.Abnormal.Throwing.Throwing.types+    , Funcons.Core.Computations.Abnormal.Failing.Failing.types+    , Funcons.Core.Computations.Abnormal.Sticking.types+    , Funcons.Core.Computations.Abnormal.Breaking.Breaking.types+    , Funcons.Core.Computations.Abnormal.Continuing.Continuing.types+    , Funcons.Core.Computations.Abnormal.Controlling.Controlling.types+    , Funcons.Core.Values.ValueTypes.ValueTypes.types+--    , Funcons.Core.Values.Composite.Sets.types+    , Funcons.Core.Values.Composite.Bits.Bits.types+    , Funcons.Core.Values.Composite.Strings.Strings.types+    , Funcons.Core.Values.Composite.Datatypes.Datatypes.types+    , Funcons.Core.Values.Composite.Lists.Lists.types+--    , Funcons.Core.Values.Composite.Multisets.types+    , Funcons.Core.Values.Composite.Sequences.Sequences.types+    , Funcons.Core.Values.Composite.Variants.Variants.types+    , Funcons.Core.Values.Composite.Records.Records.types+--    , Funcons.Core.Values.Composite.Maps.types+    , Funcons.Core.Values.Composite.Vectors.Vectors.types+    , Funcons.Core.Values.Composite.Tuples.Tuples.types+    , Funcons.Core.Values.Composite.References.References.types+    , Funcons.Core.Values.Composite.Graphs.Graphs.types+    , Funcons.Core.Values.Primitive.Floats.Floats.types+    , Funcons.Core.Values.Primitive.Integers.Integers.types+    , Funcons.Core.Values.Primitive.Unit.Unit.types+    , Funcons.Core.Values.Primitive.Booleans.Booleans.types+    , Funcons.Core.Values.Primitive.Characters.Characters.types+    , Funcons.Core.Values.Abstraction.Functions.Functions.types+    , Funcons.Core.Values.Abstraction.Patterns.Patterns.types+    , Funcons.Core.Values.Abstraction.Generic.Generic.types+    , Funcons.Core.Values.Abstraction.Thunks.Thunks.types     ]
+ cbs/Funcons/Core/Values/Abstraction/Functions/Functions.hs view
@@ -0,0 +1,75 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Values/Abstraction/Functions/Functions.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Values.Abstraction.Functions.Functions where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    [("functions",DataTypeMemberss "functions" [TPVar "DT",TPVar "T"] [DataTypeMemberConstructor "function" [TApp "abstractions" [TSortComputesFrom (TVar "DT") (TVar "T")]] (Just [TPVar "DT",TPVar "T"])])]++funcons = libFromList+    [("function",StrictFuncon stepFunction),("apply",StrictFuncon stepApply),("supply",StrictFuncon stepSupply),("compose",StrictFuncon stepCompose),("uncurry",StrictFuncon stepUncurry),("curry",StrictFuncon stepCurry),("partial-apply",StrictFuncon stepPartial_apply),("functions",StrictFuncon stepFunctions)]++function_ fargs = FApp "function" (fargs)+stepFunction fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPMetaVar "_X1"] env+            env <- sideCondition (SCIsInSort (TVar "_X1") (TName "values")) env+            rewriteTermTo (TApp "datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 'f'),FValue (Ascii 'u'),FValue (Ascii 'n'),FValue (Ascii 'c'),FValue (Ascii 't'),FValue (Ascii 'i'),FValue (Ascii 'o'),FValue (Ascii 'n')])),TVar "_X1"]) env++apply_ fargs = FApp "apply" (fargs)+stepApply fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "function" [PADT "abstraction" [VPMetaVar "X"]],VPAnnotated (VPMetaVar "V") (TName "defined-values")] env+            rewriteTermTo (TApp "give" [TVar "V",TVar "X"]) env++supply_ fargs = FApp "supply" (fargs)+stepSupply fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "function" [PADT "abstraction" [VPMetaVar "X"]],VPAnnotated (VPMetaVar "V") (TName "defined-values")] env+            rewriteTermTo (TApp "thunk" [TApp "abstraction" [TApp "give" [TVar "V",TVar "X"]]]) env++compose_ fargs = FApp "compose" (fargs)+stepCompose fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "function" [PADT "abstraction" [VPMetaVar "Y"]],PADT "function" [PADT "abstraction" [VPMetaVar "X"]]] env+            rewriteTermTo (TApp "function" [TApp "abstraction" [TApp "give" [TVar "X",TVar "Y"]]]) env++uncurry_ fargs = FApp "uncurry" (fargs)+stepUncurry fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "F") (TApp "functions" [TName "defined-values",TApp "functions" [TName "defined-values",TName "values"]])] env+            rewriteTermTo (TApp "function" [TApp "abstraction" [TApp "apply" [TApp "apply" [TVar "F",TApp "def" [TApp "index" [TFuncon (FValue (Nat 1)),TApp "tuple-elements" [TName "given"]]]],TApp "def" [TApp "index" [TFuncon (FValue (Nat 2)),TApp "tuple-elements" [TName "given"]]]]]]) env++curry_ fargs = FApp "curry" (fargs)+stepCurry fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "F") (TApp "functions" [TApp "tuples" [TName "defined-values",TName "defined-values"],TName "values"])] env+            rewriteTermTo (TApp "function" [TApp "abstraction" [TApp "partial-apply" [TVar "F",TName "given"]]]) env++partial_apply_ fargs = FApp "partial-apply" (fargs)+stepPartial_apply fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "F") (TApp "functions" [TApp "tuples" [TName "defined-values",TName "defined-values"],TName "values"]),VPAnnotated (VPMetaVar "V") (TName "defined-values")] env+            rewriteTermTo (TApp "function" [TApp "abstraction" [TApp "apply" [TVar "F",TApp "tuple" [TVar "V",TName "given"]]]]) env++functions_ = FApp "functions"+stepFunctions ts = rewriteType "functions" ts
+ cbs/Funcons/Core/Values/Abstraction/Generic/Generic.hs view
@@ -0,0 +1,43 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Values/Abstraction/Generic/Generic.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Values.Abstraction.Generic.Generic where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    [("abstractions",DataTypeMemberss "abstractions" [TPWildCard] [DataTypeMemberConstructor "abstraction" [TSortComputesFrom (TVar "DT") (TVar "T")] (Just [TPComputesFrom (TPVar "DT") (TPVar "T")])])]++funcons = libFromList+    [("abstraction",NonStrictFuncon stepAbstraction),("closure",NonStrictFuncon stepClosure),("enact",StrictFuncon stepEnact),("abstractions",StrictFuncon stepAbstractions)]++abstraction_ fargs = FApp "abstraction" (fargs)+stepAbstraction fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "_X1"] env+            rewriteTermTo (TApp "non-strict-datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 'a'),FValue (Ascii 'b'),FValue (Ascii 's'),FValue (Ascii 't'),FValue (Ascii 'r'),FValue (Ascii 'a'),FValue (Ascii 'c'),FValue (Ascii 't'),FValue (Ascii 'i'),FValue (Ascii 'o'),FValue (Ascii 'n')])),TVar "_X1"]) env++closure_ fargs = FApp "closure" (fargs)+stepClosure fargs =+    evalRules [] [step1]+    where step1 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PMetaVar "X"] env+            env <- getInhPatt "environment" (VPMetaVar "Rho") env+            stepTermTo (TApp "abstraction" [TApp "closed" [TApp "scope" [TVar "Rho",TVar "X"]]]) env++enact_ fargs = FApp "enact" (fargs)+stepEnact fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "abstraction" [VPMetaVar "X"]] env+            rewriteTermTo (TVar "X") env++abstractions_ = FApp "abstractions"+stepAbstractions ts = rewriteType "abstractions" ts
+ cbs/Funcons/Core/Values/Abstraction/Patterns/Patterns.hs view
@@ -0,0 +1,147 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Values/Abstraction/Patterns/Patterns.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Values.Abstraction.Patterns.Patterns where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    [("patterns",DataTypeMemberss "patterns" [] [DataTypeMemberConstructor "pattern" [TApp "abstractions" [TSortComputesFrom (TName "defined-values") (TName "environments")]] (Just [])])]++funcons = libFromList+    [("pattern",StrictFuncon stepPattern),("pattern-any",NullaryFuncon stepPattern_any),("pattern-bind",StrictFuncon stepPattern_bind),("pattern-type",NonStrictFuncon stepPattern_type),("pattern-else",StrictFuncon stepPattern_else),("pattern-unite",StrictFuncon stepPattern_unite),("match",StrictFuncon stepMatch),("match-loosely",StrictFuncon stepMatch_loosely),("case-match",PartiallyStrictFuncon [Strict,NonStrict] NonStrict stepCase_match),("case-match-loosely",PartiallyStrictFuncon [Strict,NonStrict] NonStrict stepCase_match_loosely),("case-variant-value",StrictFuncon stepCase_variant_value),("patterns",NullaryFuncon stepPatterns)]++pattern_ fargs = FApp "pattern" (fargs)+stepPattern fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPMetaVar "_X1"] env+            env <- sideCondition (SCIsInSort (TVar "_X1") (TName "values")) env+            rewriteTermTo (TApp "datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 'p'),FValue (Ascii 'a'),FValue (Ascii 't'),FValue (Ascii 't'),FValue (Ascii 'e'),FValue (Ascii 'r'),FValue (Ascii 'n')])),TVar "_X1"]) env++pattern_any_ = FName "pattern-any"+stepPattern_any = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "pattern" [TApp "abstraction" [TApp "map" []]]) env++pattern_bind_ fargs = FApp "pattern-bind" (fargs)+stepPattern_bind fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "I") (TName "ids")] env+            rewriteTermTo (TApp "pattern" [TApp "abstraction" [TApp "bind" [TVar "I",TName "given"]]]) env++pattern_type_ fargs = FApp "pattern-type" (fargs)+stepPattern_type fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "DT"] env+            rewriteTermTo (TApp "pattern" [TApp "abstraction" [TApp "if-true-else" [TApp "is-in-type" [TName "given",TVar "DT"],TApp "map" [],TName "fail"]]]) env++pattern_else_ fargs = FApp "pattern-else" (fargs)+stepPattern_else fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "P1") (TName "defined-values"),VPAnnotated (VPMetaVar "P2") (TName "defined-values")] env+            rewriteTermTo (TApp "pattern" [TApp "abstraction" [TApp "else" [TApp "match" [TName "given",TVar "P1"],TApp "match" [TName "given",TVar "P2"]]]]) env++pattern_unite_ fargs = FApp "pattern-unite" (fargs)+stepPattern_unite fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "P1") (TName "defined-values"),VPAnnotated (VPMetaVar "P2") (TName "defined-values")] env+            rewriteTermTo (TApp "pattern" [TApp "abstraction" [TApp "collateral" [TApp "match" [TName "given",TVar "P1"],TApp "match" [TName "given",TVar "P2"]]]]) env++match_ fargs = FApp "match" (fargs)+stepMatch fargs =+    evalRules [rewrite1,rewrite2,rewrite3,rewrite4,rewrite5] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "DV") (TName "defined-values"),PADT "pattern" [PADT "abstraction" [VPMetaVar "X"]]] env+            rewriteTermTo (TApp "give" [TVar "DV",TVar "X"]) env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "datatype-value" [VPAnnotated (VPMetaVar "I1") (TName "ids"),VPAnnotated (VPSeqVar "V1*" StarOp) (TSortSeq (TName "values") StarOp)],PADT "datatype-value" [VPAnnotated (VPMetaVar "I2") (TName "ids"),VPAnnotated (VPSeqVar "V2*" StarOp) (TSortSeq (TName "values") StarOp)]] env+            env <- sideCondition (SCInequality (TVar "I2") (TFuncon (FValue (ADTVal "list" [FValue (Ascii 'p'),FValue (Ascii 'a'),FValue (Ascii 't'),FValue (Ascii 't'),FValue (Ascii 'e'),FValue (Ascii 'r'),FValue (Ascii 'n')])))) env+            rewriteTermTo (TApp "sequential" [TApp "check-true" [TApp "is-equal" [TVar "I1",TVar "I2"]],TApp "check-true" [TApp "is-equal" [TApp "length" [TVar "V1*"],TApp "length" [TVar "V2*"]]],TApp "collateral" [TApp "interleave-map" [TApp "match" [TApp "tuple-elements" [TName "given"]],TApp "tuple-zip" [TApp "tuple" [TVar "V1*"],TApp "tuple" [TVar "V2*"]]]]]) env+          rewrite3 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "M1") (TApp "maps" [TName "values",TName "values"]),VPAnnotated (VPMetaVar "M2") (TApp "maps" [TName "values",TName "values"])] env+            env <- sideCondition (SCEquality (TApp "dom" [TVar "M2"]) (TSet [])) env+            rewriteTermTo (TApp "if-true-else" [TApp "is-equal" [TApp "dom" [TVar "M1"],TSet []],TApp "map" [],TName "fail"]) env+          rewrite4 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "M1") (TApp "maps" [TName "values",TName "values"]),VPAnnotated (VPMetaVar "M2") (TApp "maps" [TName "values",TName "values"])] env+            env <- sideCondition (SCInequality (TApp "dom" [TVar "M2"]) (TSet [])) env+            env <- sideCondition (SCPatternMatch (TApp "some-element" [TApp "dom" [TVar "M2"]]) (VPMetaVar "K")) env+            rewriteTermTo (TApp "if-true-else" [TApp "is-in-set" [TVar "K",TApp "dom" [TVar "M1"]],TApp "collateral" [TApp "match" [TApp "lookup" [TVar "M1",TVar "K"],TApp "lookup" [TVar "M2",TVar "K"]],TApp "match" [TApp "map-delete" [TVar "M1",TSet [TVar "K"]],TApp "map-delete" [TVar "M2",TSet [TVar "K"]]]],TName "fail"]) env+          rewrite5 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "DV") (TName "defined-values"),VPAnnotated (VPMetaVar "P") (TName "defined-values")] env+            env <- sideCondition (SCIsInSort (TVar "P") (TSortComplement (TSortUnion (TName "datatype-values") (TApp "maps" [TName "values",TName "values"])))) env+            rewriteTermTo (TApp "if-true-else" [TApp "is-equal" [TVar "DV",TVar "P"],TApp "map" [],TName "fail"]) env++match_loosely_ fargs = FApp "match-loosely" (fargs)+stepMatch_loosely fargs =+    evalRules [rewrite1,rewrite2,rewrite3,rewrite4,rewrite5] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "DV") (TName "defined-values"),PADT "pattern" [PADT "abstraction" [VPMetaVar "X"]]] env+            rewriteTermTo (TApp "give" [TVar "DV",TVar "X"]) env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "datatype-value" [VPAnnotated (VPMetaVar "I1") (TName "ids"),VPAnnotated (VPSeqVar "V1*" StarOp) (TSortSeq (TName "values") StarOp)],PADT "datatype-value" [VPAnnotated (VPMetaVar "I2") (TName "ids"),VPAnnotated (VPSeqVar "V2*" StarOp) (TSortSeq (TName "values") StarOp)]] env+            env <- sideCondition (SCInequality (TVar "I2") (TFuncon (FValue (ADTVal "list" [FValue (Ascii 'p'),FValue (Ascii 'a'),FValue (Ascii 't'),FValue (Ascii 't'),FValue (Ascii 'e'),FValue (Ascii 'r'),FValue (Ascii 'n')])))) env+            rewriteTermTo (TApp "sequential" [TApp "check-true" [TApp "is-equal" [TVar "I1",TVar "I2"]],TApp "check-true" [TApp "is-equal" [TApp "length" [TVar "V1*"],TApp "length" [TVar "V2*"]]],TApp "collateral" [TApp "interleave-map" [TApp "match-loosely" [TApp "tuple-elements" [TName "given"]],TApp "tuple-zip" [TApp "tuple" [TVar "V1*"],TApp "tuple" [TVar "V2*"]]]]]) env+          rewrite3 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "M1") (TApp "maps" [TName "values",TName "values"]),VPAnnotated (VPMetaVar "M2") (TApp "maps" [TName "values",TName "values"])] env+            env <- sideCondition (SCEquality (TApp "dom" [TVar "M2"]) (TSet [])) env+            rewriteTermTo (TApp "map" []) env+          rewrite4 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "M1") (TApp "maps" [TName "values",TName "values"]),VPAnnotated (VPMetaVar "M2") (TApp "maps" [TName "values",TName "values"])] env+            env <- sideCondition (SCInequality (TApp "dom" [TVar "M2"]) (TSet [])) env+            env <- sideCondition (SCPatternMatch (TApp "some-element" [TApp "dom" [TVar "M2"]]) (VPMetaVar "K")) env+            rewriteTermTo (TApp "if-true-else" [TApp "is-in-set" [TVar "K",TApp "dom" [TVar "M1"]],TApp "collateral" [TApp "match-loosely" [TApp "lookup" [TVar "M1",TVar "K"],TApp "lookup" [TVar "M2",TVar "K"]],TApp "match-loosely" [TApp "map-delete" [TVar "M1",TSet [TVar "K"]],TApp "map-delete" [TVar "M2",TSet [TVar "K"]]]],TName "fail"]) env+          rewrite5 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "DV") (TName "defined-values"),VPAnnotated (VPMetaVar "P") (TName "defined-values")] env+            env <- sideCondition (SCIsInSort (TVar "P") (TSortComplement (TSortUnion (TName "datatype-values") (TApp "maps" [TName "values",TName "values"])))) env+            rewriteTermTo (TApp "if-true-else" [TApp "is-equal" [TVar "DV",TVar "P"],TApp "map" [],TName "fail"]) env++case_match_ fargs = FApp "case-match" (fargs)+stepCase_match fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PAnnotated (PMetaVar "P") (TName "defined-values"),PMetaVar "X"] env+            rewriteTermTo (TApp "scope" [TApp "match" [TName "given",TVar "P"],TVar "X"]) env++case_match_loosely_ fargs = FApp "case-match-loosely" (fargs)+stepCase_match_loosely fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PAnnotated (PMetaVar "P") (TName "defined-values"),PMetaVar "X"] env+            rewriteTermTo (TApp "scope" [TApp "match-loosely" [TName "given",TVar "P"],TVar "X"]) env++case_variant_value_ fargs = FApp "case-variant-value" (fargs)+stepCase_variant_value fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "I") (TName "ids")] env+            rewriteTermTo (TApp "case-match" [TApp "variant" [TVar "I",TName "pattern-any"],TApp "variant-value" [TName "given"]]) env++patterns_ = FName "patterns"+stepPatterns = rewriteType "patterns" []
+ cbs/Funcons/Core/Values/Abstraction/Thunks/Thunks.hs view
@@ -0,0 +1,35 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Values/Abstraction/Thunks/Thunks.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Values.Abstraction.Thunks.Thunks where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    [("thunks",DataTypeMemberss "thunks" [TPVar "T"] [DataTypeMemberConstructor "thunk" [TApp "abstractions" [TSortComputesFrom (TName "nothing") (TVar "T")]] (Just [TPVar "T"])])]++funcons = libFromList+    [("thunk",StrictFuncon stepThunk),("force",StrictFuncon stepForce),("thunks",StrictFuncon stepThunks)]++thunk_ fargs = FApp "thunk" (fargs)+stepThunk fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPMetaVar "_X1"] env+            env <- sideCondition (SCIsInSort (TVar "_X1") (TName "values")) env+            rewriteTermTo (TApp "datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 't'),FValue (Ascii 'h'),FValue (Ascii 'u'),FValue (Ascii 'n'),FValue (Ascii 'k')])),TVar "_X1"]) env++force_ fargs = FApp "force" (fargs)+stepForce fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "thunk" [PADT "abstraction" [VPMetaVar "X"]]] env+            rewriteTermTo (TVar "X") env++thunks_ = FApp "thunks"+stepThunks ts = rewriteType "thunks" ts
+ cbs/Funcons/Core/Values/Composite/Bits/Bits.hs view
@@ -0,0 +1,80 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Values/Composite/Bits/Bits.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Values.Composite.Bits.Bits where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    [("bit-vectors",DataTypeMemberss "bit-vectors" [TPVar "N"] [DataTypeMemberConstructor "bit-vector" [TSortPower (TName "bits") (TVar "N")] (Just [TPVar "N"])])]++funcons = libFromList+    [("bits",NullaryFuncon stepBits),("bit-vector",StrictFuncon stepBit_vector),("bytes",NullaryFuncon stepBytes),("octets",NullaryFuncon stepBytes),("unsigned-bit-vector-maximum",StrictFuncon stepUnsigned_bit_vector_maximum),("signed-bit-vector-maximum",StrictFuncon stepSigned_bit_vector_maximum),("signed-bit-vector-minimum",StrictFuncon stepSigned_bit_vector_minimum),("is-in-signed-bit-vector",StrictFuncon stepIs_in_signed_bit_vector),("is-in-unsigned-bit-vector",StrictFuncon stepIs_in_unsigned_bit_vector),("bit-vectors",StrictFuncon stepBit_vectors)]++bits_ = FName "bits"+stepBits = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TName "bools") env++bit_vector_ fargs = FApp "bit-vector" (fargs)+stepBit_vector fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPSeqVar "_X1*" StarOp] env+            env <- sideCondition (SCIsInSort (TVar "_X1*") (TSortSeq (TName "values") StarOp)) env+            rewriteTermTo (TApp "datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 'b'),FValue (Ascii 'i'),FValue (Ascii 't'),FValue (Ascii '-'),FValue (Ascii 'v'),FValue (Ascii 'e'),FValue (Ascii 'c'),FValue (Ascii 't'),FValue (Ascii 'o'),FValue (Ascii 'r')])),TVar "_X1*"]) env++bytes_ = FName "bytes"+octets_ = FName "bytes"+stepBytes = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "bit-vectors" [TFuncon (FValue (Nat 8))]) env++unsigned_bit_vector_maximum_ fargs = FApp "unsigned-bit-vector-maximum" (fargs)+stepUnsigned_bit_vector_maximum fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "N") (TName "nats")] env+            rewriteTermTo (TApp "integer-subtract" [TApp "integer-power" [TFuncon (FValue (Nat 2)),TVar "N"],TFuncon (FValue (Nat 1))]) env++signed_bit_vector_maximum_ fargs = FApp "signed-bit-vector-maximum" (fargs)+stepSigned_bit_vector_maximum fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "N") (TName "nats")] env+            rewriteTermTo (TApp "integer-subtract" [TApp "integer-power" [TFuncon (FValue (Nat 2)),TApp "integer-subtract" [TVar "N",TFuncon (FValue (Nat 1))]],TFuncon (FValue (Nat 1))]) env++signed_bit_vector_minimum_ fargs = FApp "signed-bit-vector-minimum" (fargs)+stepSigned_bit_vector_minimum fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "N") (TName "nats")] env+            rewriteTermTo (TApp "integer-negate" [TApp "integer-power" [TFuncon (FValue (Nat 2)),TApp "integer-subtract" [TVar "N",TFuncon (FValue (Nat 1))]]]) env++is_in_signed_bit_vector_ fargs = FApp "is-in-signed-bit-vector" (fargs)+stepIs_in_signed_bit_vector fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "M") (TName "integers"),VPAnnotated (VPMetaVar "N") (TName "nats")] env+            rewriteTermTo (TApp "and" [TApp "integer-is-less-or-equal" [TVar "M",TApp "signed-bit-vector-maximum" [TVar "N"]],TApp "integer-is-greater-or-equal" [TVar "M",TApp "signed-bit-vector-minimum" [TVar "N"]]]) env++is_in_unsigned_bit_vector_ fargs = FApp "is-in-unsigned-bit-vector" (fargs)+stepIs_in_unsigned_bit_vector fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "M") (TName "integers"),VPAnnotated (VPMetaVar "N") (TName "nats")] env+            rewriteTermTo (TApp "and" [TApp "integer-is-less-or-equal" [TVar "M",TApp "unsigned-bit-vector-maximum" [TVar "N"]],TApp "integer-is-greater-or-equal" [TVar "M",TFuncon (FValue (Nat 0))]]) env++bit_vectors_ = FApp "bit-vectors"+stepBit_vectors ts = rewriteType "bit-vectors" ts
+ cbs/Funcons/Core/Values/Composite/Datatypes/Datatypes.hs view
@@ -0,0 +1,31 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Values/Composite/Datatypes/Datatypes.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Values.Composite.Datatypes.Datatypes where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    []++funcons = libFromList+    [("datatype-value-id",StrictFuncon stepDatatype_value_id),("datatype-value-elements",StrictFuncon stepDatatype_value_elements)]++datatype_value_id_ fargs = FApp "datatype-value-id" (fargs)+stepDatatype_value_id fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "datatype-value" [VPAnnotated (VPMetaVar "I") (TName "ids"),VPAnnotated (VPSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)]] env+            rewriteTermTo (TVar "I") env++datatype_value_elements_ fargs = FApp "datatype-value-elements" (fargs)+stepDatatype_value_elements fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "datatype-value" [VPAnnotated (VPMetaVar "I") (TName "ids"),VPAnnotated (VPSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)]] env+            rewriteTermTo (TVar "V*") env
+ cbs/Funcons/Core/Values/Composite/Graphs/Graphs.hs view
@@ -0,0 +1,23 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Values/Composite/Graphs/Graphs.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Values.Composite.Graphs.Graphs where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    []++funcons = libFromList+    [("directed-graphs",NonStrictFuncon stepDirected_graphs)]++directed_graphs_ fargs = FApp "directed-graphs" (fargs)+stepDirected_graphs fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "GVT"] env+            rewriteTermTo (TApp "maps" [TVar "GVT",TApp "sets" [TVar "GVT"]]) env
+ cbs/Funcons/Core/Values/Composite/Lists/Lists.hs view
@@ -0,0 +1,105 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Values/Composite/Lists/Lists.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Values.Composite.Lists.Lists where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    [("lists",DataTypeMemberss "lists" [TPVar "T"] [DataTypeMemberConstructor "list" [TSortSeq (TVar "T") StarOp] (Just [TPVar "T"])])]++funcons = libFromList+    [("list",StrictFuncon stepList),("list-elements",StrictFuncon stepList_elements),("list-nil",NullaryFuncon stepList_nil),("nil",NullaryFuncon stepList_nil),("list-cons",StrictFuncon stepList_cons),("cons",StrictFuncon stepList_cons),("list-head",StrictFuncon stepList_head),("head",StrictFuncon stepList_head),("list-tail",StrictFuncon stepList_tail),("tail",StrictFuncon stepList_tail),("list-length",StrictFuncon stepList_length),("list-append",StrictFuncon stepList_append),("lists",StrictFuncon stepLists)]++list_ fargs = FApp "list" (fargs)+stepList fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPSeqVar "_X1*" StarOp] env+            env <- sideCondition (SCIsInSort (TVar "_X1*") (TSortSeq (TName "values") StarOp)) env+            rewriteTermTo (TApp "datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 'l'),FValue (Ascii 'i'),FValue (Ascii 's'),FValue (Ascii 't')])),TVar "_X1*"]) env++list_elements_ fargs = FApp "list-elements" (fargs)+stepList_elements fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "list" [VPAnnotated (VPSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)]] env+            rewriteTermTo (TVar "V*") env++list_nil_ = FName "list-nil"+nil_ = FName "list-nil"+stepList_nil = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "list" []) env++list_cons_ fargs = FApp "list-cons" (fargs)+cons_ fargs = FApp "list-cons" (fargs)+stepList_cons fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values"),PADT "datatype-value" [VPLit (ADTVal "list" [FValue (Ascii 'l'),FValue (Ascii 'i'),FValue (Ascii 's'),FValue (Ascii 't')]),VPAnnotated (VPSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)]] env+            rewriteTermTo (TApp "list" [TVar "V",TVar "V*"]) env++list_head_ fargs = FApp "list-head" (fargs)+head_ fargs = FApp "list-head" (fargs)+stepList_head fargs =+    evalRules [rewrite1,rewrite2] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "datatype-value" [VPLit (ADTVal "list" [FValue (Ascii 'l'),FValue (Ascii 'i'),FValue (Ascii 's'),FValue (Ascii 't')]),VPAnnotated (VPMetaVar "V") (TName "values"),VPAnnotated (VPSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)]] env+            rewriteTermTo (TVar "V") env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "datatype-value" [VPLit (ADTVal "list" [FValue (Ascii 'l'),FValue (Ascii 'i'),FValue (Ascii 's'),FValue (Ascii 't')])]] env+            rewriteTermTo (TName "none") env++list_tail_ fargs = FApp "list-tail" (fargs)+tail_ fargs = FApp "list-tail" (fargs)+stepList_tail fargs =+    evalRules [rewrite1,rewrite2] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "datatype-value" [VPLit (ADTVal "list" [FValue (Ascii 'l'),FValue (Ascii 'i'),FValue (Ascii 's'),FValue (Ascii 't')]),VPAnnotated (VPMetaVar "V") (TName "values"),VPAnnotated (VPSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)]] env+            rewriteTermTo (TApp "list" [TVar "V*"]) env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "datatype-value" [VPLit (ADTVal "list" [FValue (Ascii 'l'),FValue (Ascii 'i'),FValue (Ascii 's'),FValue (Ascii 't')])]] env+            rewriteTermTo (TName "none") env++list_length_ fargs = FApp "list-length" (fargs)+stepList_length fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "datatype-value" [VPLit (ADTVal "list" [FValue (Ascii 'l'),FValue (Ascii 'i'),FValue (Ascii 's'),FValue (Ascii 't')]),VPAnnotated (VPSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)]] env+            rewriteTermTo (TApp "length" [TVar "V*"]) env++list_append_ fargs = FApp "list-append" (fargs)+stepList_append fargs =+    evalRules [rewrite1,rewrite2,rewrite3,rewrite4] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "datatype-value" [VPLit (ADTVal "list" [FValue (Ascii 'l'),FValue (Ascii 'i'),FValue (Ascii 's'),FValue (Ascii 't')]),VPAnnotated (VPSeqVar "V1*" StarOp) (TSortSeq (TName "values") StarOp)],PADT "datatype-value" [VPLit (ADTVal "list" [FValue (Ascii 'l'),FValue (Ascii 'i'),FValue (Ascii 's'),FValue (Ascii 't')]),VPAnnotated (VPSeqVar "V2*" StarOp) (TSortSeq (TName "values") StarOp)]] env+            rewriteTermTo (TApp "list" [TVar "V1*",TVar "V2*"]) env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "L1") (TApp "lists" [TName "values"]),VPAnnotated (VPMetaVar "L2") (TApp "lists" [TName "values"]),VPAnnotated (VPMetaVar "L3") (TApp "lists" [TName "values"]),VPAnnotated (VPSeqVar "L*" StarOp) (TSortSeq (TApp "lists" [TName "values"]) StarOp)] env+            rewriteTermTo (TApp "list-append" [TVar "L1",TApp "list-append" [TVar "L2",TVar "L3",TVar "L*"]]) env+          rewrite3 = do+            let env = emptyEnv+            env <- vsMatch fargs [] env+            rewriteTermTo (TApp "list" []) env+          rewrite4 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "L") (TApp "lists" [TName "values"])] env+            rewriteTermTo (TVar "L") env++lists_ = FApp "lists"+stepLists ts = rewriteType "lists" ts
+ cbs/Funcons/Core/Values/Composite/Records/Records.hs view
@@ -0,0 +1,35 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Values/Composite/Records/Records.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Values.Composite.Records.Records where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    [("records",DataTypeMemberss "records" [TPVar "MIT"] [DataTypeMemberConstructor "record" [TApp "maps" [TName "ids",TName "values"]] (Just [TPVar "MIT"])])]++funcons = libFromList+    [("record",StrictFuncon stepRecord),("record-select",StrictFuncon stepRecord_select),("records",StrictFuncon stepRecords)]++record_ fargs = FApp "record" (fargs)+stepRecord fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPMetaVar "_X1"] env+            env <- sideCondition (SCIsInSort (TVar "_X1") (TName "values")) env+            rewriteTermTo (TApp "datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 'r'),FValue (Ascii 'e'),FValue (Ascii 'c'),FValue (Ascii 'o'),FValue (Ascii 'r'),FValue (Ascii 'd')])),TVar "_X1"]) env++record_select_ fargs = FApp "record-select" (fargs)+stepRecord_select fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "record" [VPAnnotated (VPMetaVar "MIV") (TApp "maps" [TName "ids",TName "values"])],VPAnnotated (VPMetaVar "I") (TName "ids")] env+            rewriteTermTo (TApp "lookup" [TVar "MIV",TVar "I"]) env++records_ = FApp "records"+stepRecords ts = rewriteType "records" ts
+ cbs/Funcons/Core/Values/Composite/References/References.hs view
@@ -0,0 +1,47 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Values/Composite/References/References.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Values.Composite.References.References where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    [("references",DataTypeMemberss "references" [TPVar "VT"] [DataTypeMemberConstructor "reference" [TVar "VT"] (Just [TPVar "VT"])])]++funcons = libFromList+    [("reference",StrictFuncon stepReference),("pointers",NonStrictFuncon stepPointers),("dereference",StrictFuncon stepDereference),("references",StrictFuncon stepReferences)]++reference_ fargs = FApp "reference" (fargs)+stepReference fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPMetaVar "_X1"] env+            env <- sideCondition (SCIsInSort (TVar "_X1") (TName "values")) env+            rewriteTermTo (TApp "datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 'r'),FValue (Ascii 'e'),FValue (Ascii 'f'),FValue (Ascii 'e'),FValue (Ascii 'r'),FValue (Ascii 'e'),FValue (Ascii 'n'),FValue (Ascii 'c'),FValue (Ascii 'e')])),TVar "_X1"]) env++pointers_ fargs = FApp "pointers" (fargs)+stepPointers fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- fsMatch fargs [PMetaVar "VT"] env+            rewriteTermTo (TSortUnion (TName "unit-type") (TApp "references" [TVar "VT"])) env++dereference_ fargs = FApp "dereference" (fargs)+stepDereference fargs =+    evalRules [rewrite1,rewrite2] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "reference" [VPAnnotated (VPMetaVar "DV") (TName "defined-values")]] env+            rewriteTermTo (TVar "DV") env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "null-value" []] env+            rewriteTermTo (TName "none") env++references_ = FApp "references"+stepReferences ts = rewriteType "references" ts
+ cbs/Funcons/Core/Values/Composite/Sequences/Sequences.hs view
@@ -0,0 +1,175 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Values/Composite/Sequences/Sequences.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Values.Composite.Sequences.Sequences where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    []++funcons = libFromList+    [("length",StrictFuncon stepLength),("index",StrictFuncon stepIndex),("first",StrictFuncon stepFirst),("second",StrictFuncon stepSecond),("third",StrictFuncon stepThird),("is-in",StrictFuncon stepIs_in),("first-n",StrictFuncon stepFirst_n),("drop-first-n",StrictFuncon stepDrop_first_n),("reverse",StrictFuncon stepReverse),("n-of",StrictFuncon stepN_of),("intersperse",StrictFuncon stepIntersperse),("filter-defined",StrictFuncon stepFilter_defined)]++length_ fargs = FApp "length" (fargs)+stepLength fargs =+    evalRules [rewrite1,rewrite2] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [] env+            rewriteTermTo (TFuncon (FValue (Nat 0))) env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values"),VPAnnotated (VPSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)] env+            rewriteTermTo (TApp "nat-succ" [TApp "length" [TVar "V*"]]) env++index_ fargs = FApp "index" (fargs)+stepIndex fargs =+    evalRules [rewrite1,rewrite2,rewrite3,rewrite4] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPLit (Nat 1),VPAnnotated (VPMetaVar "V") (TName "values"),VPAnnotated (VPSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)] env+            rewriteTermTo (TVar "V") env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "N") (TName "pos-ints"),VPAnnotated (VPMetaVar "V") (TName "values"),VPAnnotated (VPSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)] env+            env <- sideCondition (SCPatternMatch (TApp "nat-pred" [TVar "N"]) (VPMetaVar "N'")) env+            rewriteTermTo (TApp "index" [TVar "N'",TVar "V*"]) env+          rewrite3 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPLit (Nat 0),VPAnnotated (VPSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)] env+            rewriteTermTo (TName "none") env+          rewrite4 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "P") (TName "pos-ints")] env+            rewriteTermTo (TName "none") env++first_ fargs = FApp "first" (fargs)+stepFirst fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V1") (TName "values"),VPAnnotated (VPSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)] env+            rewriteTermTo (TVar "V1") env++second_ fargs = FApp "second" (fargs)+stepSecond fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V1") (TName "values"),VPAnnotated (VPMetaVar "V2") (TName "values"),VPAnnotated (VPSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)] env+            rewriteTermTo (TVar "V2") env++third_ fargs = FApp "third" (fargs)+stepThird fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V1") (TName "values"),VPAnnotated (VPMetaVar "V2") (TName "values"),VPAnnotated (VPMetaVar "V3") (TName "values"),VPAnnotated (VPSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)] env+            rewriteTermTo (TVar "V3") env++is_in_ fargs = FApp "is-in" (fargs)+stepIs_in fargs =+    evalRules [rewrite1,rewrite2] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values"),VPAnnotated (VPMetaVar "V'") (TName "values"),VPAnnotated (VPSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)] env+            rewriteTermTo (TApp "or" [TApp "is-equal" [TVar "V",TVar "V'"],TApp "is-in" [TVar "V",TVar "V*"]]) env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values")] env+            rewriteTermTo (TName "false") env++first_n_ fargs = FApp "first-n" (fargs)+stepFirst_n fargs =+    evalRules [rewrite1,rewrite2,rewrite3] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPLit (Nat 0),VPAnnotated (VPSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)] env+            rewriteTermTo (TSeq []) env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "N") (TName "pos-ints"),VPAnnotated (VPMetaVar "V") (TName "values"),VPAnnotated (VPSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)] env+            env <- sideCondition (SCPatternMatch (TApp "nat-pred" [TVar "N"]) (VPMetaVar "N'")) env+            rewriteTermTo (TApp "first-n" [TVar "N'",TVar "V*"]) env+          rewrite3 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "N") (TName "pos-ints")] env+            rewriteTermTo (TName "none") env++drop_first_n_ fargs = FApp "drop-first-n" (fargs)+stepDrop_first_n fargs =+    evalRules [rewrite1,rewrite2,rewrite3] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPLit (Nat 0),VPAnnotated (VPSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)] env+            rewriteTermTo (TVar "V*") env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "N") (TName "pos-ints"),VPAnnotated (VPMetaVar "V") (TName "values"),VPAnnotated (VPSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)] env+            env <- sideCondition (SCPatternMatch (TApp "nat-pred" [TVar "N"]) (VPMetaVar "N'")) env+            rewriteTermTo (TApp "drop-first-n" [TVar "N'",TVar "V*"]) env+          rewrite3 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "N") (TName "pos-ints")] env+            rewriteTermTo (TName "none") env++reverse_ fargs = FApp "reverse" (fargs)+stepReverse fargs =+    evalRules [rewrite1,rewrite2] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [] env+            rewriteTermTo (TSeq []) env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values"),VPAnnotated (VPSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)] env+            rewriteTermTo (TSeq [TApp "reverse" [TVar "V*"],TVar "V"]) env++n_of_ fargs = FApp "n-of" (fargs)+stepN_of fargs =+    evalRules [rewrite1,rewrite2] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPLit (Nat 0),VPMetaVar "V"] env+            rewriteTermTo (TSeq []) env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "N") (TName "pos-ints"),VPAnnotated (VPMetaVar "V") (TName "values")] env+            env <- sideCondition (SCPatternMatch (TApp "nat-pred" [TVar "N"]) (VPMetaVar "N'")) env+            rewriteTermTo (TSeq [TVar "V",TApp "n-of" [TVar "N'",TVar "V"]]) env++intersperse_ fargs = FApp "intersperse" (fargs)+stepIntersperse fargs =+    evalRules [rewrite1,rewrite2,rewrite3] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V'") (TName "values")] env+            rewriteTermTo (TSeq []) env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V'") (TName "values"),VPMetaVar "V"] env+            rewriteTermTo (TVar "V") env+          rewrite3 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V'") (TName "values"),VPAnnotated (VPMetaVar "V1") (TName "values"),VPAnnotated (VPMetaVar "V2") (TName "values"),VPAnnotated (VPSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)] env+            rewriteTermTo (TSeq [TVar "V1",TVar "V'",TApp "intersperse" [TVar "V'",TVar "V2",TVar "V*"]]) env++filter_defined_ fargs = FApp "filter-defined" (fargs)+stepFilter_defined fargs =+    evalRules [rewrite1,rewrite2,rewrite3] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "defined-values"),VPAnnotated (VPSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)] env+            rewriteTermTo (TSeq [TVar "V",TApp "filter-defined" [TVar "V*"]]) env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "none" [],VPAnnotated (VPSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)] env+            rewriteTermTo (TApp "filter-defined" [TVar "V*"]) env+          rewrite3 = do+            let env = emptyEnv+            env <- vsMatch fargs [] env+            rewriteTermTo (TSeq []) env
+ cbs/Funcons/Core/Values/Composite/Strings/Strings.hs view
@@ -0,0 +1,37 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Values/Composite/Strings/Strings.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Values.Composite.Strings.Strings where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    []++funcons = libFromList+    [("strings",NullaryFuncon stepStrings),("string",StrictFuncon stepString),("string-append",StrictFuncon stepString_append)]++strings_ = FName "strings"+stepStrings = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "lists" [TName "characters"]) env++string_ fargs = FApp "string" (fargs)+stepString fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPSeqVar "C*" StarOp) (TSortSeq (TName "characters") StarOp)] env+            rewriteTermTo (TApp "list" [TVar "C*"]) env++string_append_ fargs = FApp "string-append" (fargs)+stepString_append fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPSeqVar "S*" StarOp) (TSortSeq (TName "strings") StarOp)] env+            rewriteTermTo (TApp "list-append" [TVar "S*"]) env
+ cbs/Funcons/Core/Values/Composite/Tuples/Tuples.hs view
@@ -0,0 +1,55 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Values/Composite/Tuples/Tuples.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Values.Composite.Tuples.Tuples where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    [("tuples",DataTypeMemberss "tuples" [TPSeqVar "T*" StarOp] [DataTypeMemberConstructor "tuple" [TVar "T*"] (Just [TPSeqVar "T*" StarOp])])]++funcons = libFromList+    [("tuple",StrictFuncon stepTuple),("tuple-elements",StrictFuncon stepTuple_elements),("tuple-zip",StrictFuncon stepTuple_zip),("tuples",StrictFuncon stepTuples)]++tuple_ fargs = FApp "tuple" (fargs)+stepTuple fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPSeqVar "_X1*" StarOp] env+            env <- sideCondition (SCIsInSort (TVar "_X1*") (TSortSeq (TName "values") StarOp)) env+            rewriteTermTo (TApp "datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 't'),FValue (Ascii 'u'),FValue (Ascii 'p'),FValue (Ascii 'l'),FValue (Ascii 'e')])),TVar "_X1*"]) env++tuple_elements_ fargs = FApp "tuple-elements" (fargs)+stepTuple_elements fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "tuple" [VPAnnotated (VPSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)]] env+            rewriteTermTo (TVar "V*") env++tuple_zip_ fargs = FApp "tuple-zip" (fargs)+stepTuple_zip fargs =+    evalRules [rewrite1,rewrite2,rewrite3,rewrite4] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "tuple" [VPAnnotated (VPMetaVar "V1") (TName "values"),VPAnnotated (VPSeqVar "V1*" StarOp) (TSortSeq (TName "values") StarOp)],PADT "tuple" [VPAnnotated (VPMetaVar "V2") (TName "values"),VPAnnotated (VPSeqVar "V2*" StarOp) (TSortSeq (TName "values") StarOp)]] env+            rewriteTermTo (TSeq [TApp "tuple" [TVar "V1",TVar "V2"],TApp "tuple-zip" [TApp "tuple" [TVar "V1*"],TApp "tuple" [TVar "V2*"]]]) env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "tuple" [],PADT "tuple" []] env+            rewriteTermTo (TSeq []) env+          rewrite3 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "tuple" [VPAnnotated (VPSeqVar "V1+" PlusOp) (TSortSeq (TName "values") PlusOp)],PADT "tuple" []] env+            rewriteTermTo (TName "none") env+          rewrite4 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "tuple" [],PADT "tuple" [VPAnnotated (VPSeqVar "V2+" PlusOp) (TSortSeq (TName "values") PlusOp)]] env+            rewriteTermTo (TName "none") env++tuples_ = FApp "tuples"+stepTuples ts = rewriteType "tuples" ts
+ cbs/Funcons/Core/Values/Composite/Variants/Variants.hs view
@@ -0,0 +1,44 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Values/Composite/Variants/Variants.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Values.Composite.Variants.Variants where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    [("variants",DataTypeMemberss "variants" [TPVar "MIT"] [DataTypeMemberConstructor "variant" [TName "ids",TName "defined-values"] (Just [TPVar "MIT"])])]++funcons = libFromList+    [("variant",StrictFuncon stepVariant),("variant-id",StrictFuncon stepVariant_id),("variant-value",StrictFuncon stepVariant_value),("variants",StrictFuncon stepVariants)]++variant_ fargs = FApp "variant" (fargs)+stepVariant fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPMetaVar "_X1",VPMetaVar "_X2"] env+            env <- sideCondition (SCIsInSort (TVar "_X1") (TName "values")) env+            env <- sideCondition (SCIsInSort (TVar "_X2") (TName "values")) env+            rewriteTermTo (TApp "datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 'v'),FValue (Ascii 'a'),FValue (Ascii 'r'),FValue (Ascii 'i'),FValue (Ascii 'a'),FValue (Ascii 'n'),FValue (Ascii 't')])),TVar "_X1",TVar "_X2"]) env++variant_id_ fargs = FApp "variant-id" (fargs)+stepVariant_id fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "variant" [VPAnnotated (VPMetaVar "I") (TName "ids"),VPAnnotated (VPMetaVar "DV") (TName "defined-values")]] env+            rewriteTermTo (TVar "I") env++variant_value_ fargs = FApp "variant-value" (fargs)+stepVariant_value fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "variant" [VPAnnotated (VPMetaVar "I") (TName "ids"),VPAnnotated (VPMetaVar "DV") (TName "defined-values")]] env+            rewriteTermTo (TVar "DV") env++variants_ = FApp "variants"+stepVariants ts = rewriteType "variants" ts
+ cbs/Funcons/Core/Values/Composite/Vectors/Vectors.hs view
@@ -0,0 +1,35 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Values/Composite/Vectors/Vectors.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Values.Composite.Vectors.Vectors where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    [("vectors",DataTypeMemberss "vectors" [TPVar "T"] [DataTypeMemberConstructor "vector" [TSortSeq (TVar "T") StarOp] (Just [TPVar "T"])])]++funcons = libFromList+    [("vector",StrictFuncon stepVector),("vector-elements",StrictFuncon stepVector_elements),("vectors",StrictFuncon stepVectors)]++vector_ fargs = FApp "vector" (fargs)+stepVector fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPSeqVar "_X1*" StarOp] env+            env <- sideCondition (SCIsInSort (TVar "_X1*") (TSortSeq (TName "values") StarOp)) env+            rewriteTermTo (TApp "datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 'v'),FValue (Ascii 'e'),FValue (Ascii 'c'),FValue (Ascii 't'),FValue (Ascii 'o'),FValue (Ascii 'r')])),TVar "_X1*"]) env++vector_elements_ fargs = FApp "vector-elements" (fargs)+stepVector_elements fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "vector" [VPAnnotated (VPSeqVar "V*" StarOp) (TSortSeq (TName "values") StarOp)]] env+            rewriteTermTo (TVar "V*") env++vectors_ = FApp "vectors"+stepVectors ts = rewriteType "vectors" ts
− cbs/Funcons/Core/Values/CompositeValues/AlgebraicDatatypeValues/Records.hs 
@@ -1,34 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Values/Composite values/Algebraic datatype values/records.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Values.CompositeValues.AlgebraicDatatypeValues.Records where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    [("records",DataTypeMembers [(Nothing,TApp "maps" (TTuple [TName "values",TName "types"]))] [DataTypeConstructor "record" (TTuple [TApp "maps" (TTuple [TName "values",TName "values"])])])]--funcons = libFromList-    [("record-field-map",StrictFuncon stepRecord_field_map),("record-select",StrictFuncon stepRecord_select),("records",StrictFuncon stepRecords),("record",StrictFuncon stepRecord)]--record_field_map_ fargs = FApp "record-field-map" (FTuple fargs)-stepRecord_field_map fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [PADT "record" [VPMetaVar "M"]] env-            rewriteTermTo (TVar "M") env--record_select_ fargs = FApp "record-select" (FTuple fargs)-stepRecord_select fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "R") (TName "values"),VPAnnotated (VPMetaVar "K") (TName "values")] env-            rewriteTermTo (TApp "lookup" (TTuple [TVar "K",TApp "record-field-map" (TTuple [TVar "R"])])) env--stepRecord vs = rewritten (ADTVal "record" vs)--stepRecords ts = rewriteType "records" ts
− cbs/Funcons/Core/Values/CompositeValues/AlgebraicDatatypeValues/References.hs 
@@ -1,26 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Values/Composite values/Algebraic datatype values/references.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Values.CompositeValues.AlgebraicDatatypeValues.References where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    [("references",DataTypeMembers [(Just "T",TName "types")] [DataTypeConstructor "reference" (TTuple [TVar "T"])])]--funcons = libFromList-    [("pointers",StrictFuncon stepPointers),("references",StrictFuncon stepReferences),("reference",StrictFuncon stepReference)]--pointers_ fargs = FApp "pointers" (FTuple fargs)-stepPointers fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "T") (TName "values")] env-            rewriteTermTo (TSortUnion (TName "unit-type") (TApp "references" (TTuple [TVar "T"]))) env--stepReference vs = rewritten (ADTVal "reference" vs)--stepReferences ts = rewriteType "references" ts
− cbs/Funcons/Core/Values/CompositeValues/AlgebraicDatatypeValues/Variants.hs 
@@ -1,37 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Values/Composite values/Algebraic datatype values/variants.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Values.CompositeValues.AlgebraicDatatypeValues.Variants where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    [("variants",DataTypeMembers [(Nothing,TApp "maps" (TTuple [TName "values",TName "types"]))] [DataTypeConstructor "variant" (TTuple [TName "values",TName "values"])])]--funcons = libFromList-    [("variant-tag",StrictFuncon stepVariant_tag),("variant-value",StrictFuncon stepVariant_value),("variants",StrictFuncon stepVariants),("variant",StrictFuncon stepVariant)]---- |--- /variants(M)/ is the type of tagged values /variant(K,V)/ where /V/ . ---   /variant-tag(V)/ returns the tag of a variant /V/ /variant-value(V)/ returns the tagged value of a variant /V/ -variant_tag_ fargs = FApp "variant-tag" (FTuple fargs)-stepVariant_tag fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [PADT "variant" [VPMetaVar "K",VPWildCard]] env-            rewriteTermTo (TVar "K") env--variant_value_ fargs = FApp "variant-value" (FTuple fargs)-stepVariant_value fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [PADT "variant" [VPWildCard,VPMetaVar "V"]] env-            rewriteTermTo (TVar "V") env--stepVariant vs = rewritten (ADTVal "variant" vs)--stepVariants ts = rewriteType "variants" ts
− cbs/Funcons/Core/Values/CompositeValues/Collections/DirectedGraphs.hs 
@@ -1,22 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Values/Composite values/Collections/directed-graphs.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Values.CompositeValues.Collections.DirectedGraphs where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("directed-graphs",StrictFuncon stepDirected_graphs)]--directed_graphs_ fargs = FApp "directed-graphs" (FTuple fargs)-stepDirected_graphs fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "T") (TName "values")] env-            rewriteTermTo (TApp "maps" (TTuple [TVar "T",TApp "sets" (TTuple [TVar "T"])])) env
− cbs/Funcons/Core/Values/CompositeValues/Collections/Tuples.hs 
@@ -1,22 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Values/Composite values/Collections/tuples.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Values.CompositeValues.Collections.Tuples where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("tuples",StrictFuncon stepTuples)]--tuples_ fargs = FApp "tuples" (FTuple fargs)-stepTuples fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPSeqVar "T*" StarOp) (TName "values")] env-            rewriteTermTo (TTuple [TVar "T*"]) env
+ cbs/Funcons/Core/Values/Primitive/Booleans/Booleans.hs view
@@ -0,0 +1,115 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Values/Primitive/Booleans/Booleans.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Values.Primitive.Booleans.Booleans where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    [("booleans",DataTypeMemberss "booleans" [] [DataTypeMemberConstructor "true" [] (Just []),DataTypeMemberConstructor "false" [] (Just [])]),("bools",DataTypeMemberss "bools" [] [DataTypeMemberConstructor "true" [] (Just []),DataTypeMemberConstructor "false" [] (Just [])])]++funcons = libFromList+    [("true",NullaryFuncon stepTrue),("false",NullaryFuncon stepFalse),("not",StrictFuncon stepNot),("implies",StrictFuncon stepImplies),("and",StrictFuncon stepAnd),("or",StrictFuncon stepOr),("exclusive-or",StrictFuncon stepExclusive_or),("xor",StrictFuncon stepExclusive_or),("booleans",NullaryFuncon stepBooleans),("bools",NullaryFuncon stepBooleans)]++true_ = FName "true"+stepTrue = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 't'),FValue (Ascii 'r'),FValue (Ascii 'u'),FValue (Ascii 'e')]))]) env++false_ = FName "false"+stepFalse = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 'f'),FValue (Ascii 'a'),FValue (Ascii 'l'),FValue (Ascii 's'),FValue (Ascii 'e')]))]) env++not_ fargs = FApp "not" (fargs)+stepNot fargs =+    evalRules [rewrite1,rewrite2] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "false" []] env+            rewriteTermTo (TName "true") env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "true" []] env+            rewriteTermTo (TName "false") env++implies_ fargs = FApp "implies" (fargs)+stepImplies fargs =+    evalRules [rewrite1,rewrite2,rewrite3,rewrite4] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "false" [],PADT "false" []] env+            rewriteTermTo (TName "true") env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "false" [],PADT "true" []] env+            rewriteTermTo (TName "true") env+          rewrite3 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "true" [],PADT "true" []] env+            rewriteTermTo (TName "true") env+          rewrite4 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "true" [],PADT "false" []] env+            rewriteTermTo (TName "false") env++and_ fargs = FApp "and" (fargs)+stepAnd fargs =+    evalRules [rewrite1,rewrite2,rewrite3] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [] env+            rewriteTermTo (TName "true") env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "false" [],VPAnnotated (VPSeqVar "B*" StarOp) (TSortSeq (TName "booleans") StarOp)] env+            rewriteTermTo (TName "false") env+          rewrite3 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "true" [],VPAnnotated (VPSeqVar "B*" StarOp) (TSortSeq (TName "booleans") StarOp)] env+            rewriteTermTo (TApp "and" [TVar "B*"]) env++or_ fargs = FApp "or" (fargs)+stepOr fargs =+    evalRules [rewrite1,rewrite2,rewrite3] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [] env+            rewriteTermTo (TName "false") env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "true" [],VPAnnotated (VPSeqVar "B*" StarOp) (TSortSeq (TName "booleans") StarOp)] env+            rewriteTermTo (TName "true") env+          rewrite3 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "false" [],VPAnnotated (VPSeqVar "B*" StarOp) (TSortSeq (TName "booleans") StarOp)] env+            rewriteTermTo (TApp "or" [TVar "B*"]) env++exclusive_or_ fargs = FApp "exclusive-or" (fargs)+xor_ fargs = FApp "exclusive-or" (fargs)+stepExclusive_or fargs =+    evalRules [rewrite1,rewrite2,rewrite3,rewrite4] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "false" [],PADT "false" []] env+            rewriteTermTo (TName "false") env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "false" [],PADT "true" []] env+            rewriteTermTo (TName "true") env+          rewrite3 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "true" [],PADT "false" []] env+            rewriteTermTo (TName "true") env+          rewrite4 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "true" [],PADT "true" []] env+            rewriteTermTo (TName "false") env++booleans_ = FName "booleans"+stepBooleans = rewriteType "booleans" []
+ cbs/Funcons/Core/Values/Primitive/Characters/Characters.hs view
@@ -0,0 +1,102 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Values/Primitive/Characters/Characters.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Values.Primitive.Characters.Characters where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    []++funcons = libFromList+    [("unicode-point",StrictFuncon stepUnicode_point),("unicode",StrictFuncon stepUnicode_point),("iso-latin-1-points",NullaryFuncon stepIso_latin_1_points),("ascii-points",NullaryFuncon stepAscii_points),("ascii-character",StrictFuncon stepAscii_character),("backspace",NullaryFuncon stepBackspace),("horizontal-tab",NullaryFuncon stepHorizontal_tab),("line-feed",NullaryFuncon stepLine_feed),("form-feed",NullaryFuncon stepForm_feed),("carriage-return",NullaryFuncon stepCarriage_return),("double-quote",NullaryFuncon stepDouble_quote),("single-quote",NullaryFuncon stepSingle_quote),("backslash",NullaryFuncon stepBackslash)]++unicode_point_ fargs = FApp "unicode-point" (fargs)+unicode_ fargs = FApp "unicode-point" (fargs)+stepUnicode_point fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "unicode-character" [VPAnnotated (VPMetaVar "UP") (TName "unicode-points")]] env+            rewriteTermTo (TVar "UP") env++iso_latin_1_points_ = FName "iso-latin-1-points"+stepIso_latin_1_points = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "bounded-integers" [TFuncon (FValue (Nat 0)),TApp "unsigned-bit-vector-maximum" [TFuncon (FValue (Nat 8))]]) env++ascii_points_ = FName "ascii-points"+stepAscii_points = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "bounded-integers" [TFuncon (FValue (Nat 0)),TApp "unsigned-bit-vector-maximum" [TFuncon (FValue (Nat 7))]]) env++ascii_character_ fargs = FApp "ascii-character" (fargs)+stepAscii_character fargs =+    evalRules [rewrite1,rewrite2,rewrite3] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "datatype-value" [VPLit (ADTVal "list" [FValue (Ascii 'l'),FValue (Ascii 'i'),FValue (Ascii 's'),FValue (Ascii 't')]),VPAnnotated (VPMetaVar "C") (TName "ascii-characters")]] env+            rewriteTermTo (TVar "C") env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "datatype-value" [VPLit (ADTVal "list" [FValue (Ascii 'l'),FValue (Ascii 'i'),FValue (Ascii 's'),FValue (Ascii 't')]),VPAnnotated (VPMetaVar "C") (TName "characters")]] env+            env <- sideCondition (SCIsInSort (TVar "C") (TSortComplement (TName "ascii-characters"))) env+            rewriteTermTo (TName "none") env+          rewrite3 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "datatype-value" [VPLit (ADTVal "list" [FValue (Ascii 'l'),FValue (Ascii 'i'),FValue (Ascii 's'),FValue (Ascii 't')]),VPAnnotated (VPSeqVar "C*" StarOp) (TSortSeq (TName "characters") StarOp)]] env+            env <- sideCondition (SCInequality (TApp "length" [TVar "C*"]) (TFuncon (FValue (Nat 1)))) env+            rewriteTermTo (TName "none") env++backspace_ = FName "backspace"+stepBackspace = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "unicode-character" [TApp "hexadecimal-natural" [TFuncon (FValue (ADTVal "list" [FValue (Ascii '0'),FValue (Ascii '0'),FValue (Ascii '0'),FValue (Ascii '8')]))]]) env++horizontal_tab_ = FName "horizontal-tab"+stepHorizontal_tab = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "unicode-character" [TApp "hexadecimal-natural" [TFuncon (FValue (ADTVal "list" [FValue (Ascii '0'),FValue (Ascii '0'),FValue (Ascii '0'),FValue (Ascii '9')]))]]) env++line_feed_ = FName "line-feed"+stepLine_feed = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "unicode-character" [TApp "hexadecimal-natural" [TFuncon (FValue (ADTVal "list" [FValue (Ascii '0'),FValue (Ascii '0'),FValue (Ascii '0'),FValue (Ascii 'a')]))]]) env++form_feed_ = FName "form-feed"+stepForm_feed = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "unicode-character" [TApp "hexadecimal-natural" [TFuncon (FValue (ADTVal "list" [FValue (Ascii '0'),FValue (Ascii '0'),FValue (Ascii '0'),FValue (Ascii 'c')]))]]) env++carriage_return_ = FName "carriage-return"+stepCarriage_return = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "unicode-character" [TApp "hexadecimal-natural" [TFuncon (FValue (ADTVal "list" [FValue (Ascii '0'),FValue (Ascii '0'),FValue (Ascii '0'),FValue (Ascii 'd')]))]]) env++double_quote_ = FName "double-quote"+stepDouble_quote = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "unicode-character" [TApp "hexadecimal-natural" [TFuncon (FValue (ADTVal "list" [FValue (Ascii '0'),FValue (Ascii '0'),FValue (Ascii '2'),FValue (Ascii '2')]))]]) env++single_quote_ = FName "single-quote"+stepSingle_quote = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "unicode-character" [TApp "hexadecimal-natural" [TFuncon (FValue (ADTVal "list" [FValue (Ascii '0'),FValue (Ascii '0'),FValue (Ascii '2'),FValue (Ascii '7')]))]]) env++backslash_ = FName "backslash"+stepBackslash = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "unicode-character" [TApp "hexadecimal-natural" [TFuncon (FValue (ADTVal "list" [FValue (Ascii '0'),FValue (Ascii '0'),FValue (Ascii '5'),FValue (Ascii 'c')]))]]) env
+ cbs/Funcons/Core/Values/Primitive/Floats/Floats.hs view
@@ -0,0 +1,48 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Values/Primitive/Floats/Floats.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Values.Primitive.Floats.Floats where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    [("float-formats",DataTypeMemberss "float-formats" [] [DataTypeMemberConstructor "binary32" [] (Just []),DataTypeMemberConstructor "binary64" [] (Just []),DataTypeMemberConstructor "binary128" [] (Just []),DataTypeMemberConstructor "decimal64" [] (Just []),DataTypeMemberConstructor "decimal128" [] (Just [])])]++funcons = libFromList+    [("binary32",NullaryFuncon stepBinary32),("binary64",NullaryFuncon stepBinary64),("binary128",NullaryFuncon stepBinary128),("decimal64",NullaryFuncon stepDecimal64),("decimal128",NullaryFuncon stepDecimal128),("float-formats",NullaryFuncon stepFloat_formats)]++binary32_ = FName "binary32"+stepBinary32 = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 'b'),FValue (Ascii 'i'),FValue (Ascii 'n'),FValue (Ascii 'a'),FValue (Ascii 'r'),FValue (Ascii 'y'),FValue (Ascii '3'),FValue (Ascii '2')]))]) env++binary64_ = FName "binary64"+stepBinary64 = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 'b'),FValue (Ascii 'i'),FValue (Ascii 'n'),FValue (Ascii 'a'),FValue (Ascii 'r'),FValue (Ascii 'y'),FValue (Ascii '6'),FValue (Ascii '4')]))]) env++binary128_ = FName "binary128"+stepBinary128 = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 'b'),FValue (Ascii 'i'),FValue (Ascii 'n'),FValue (Ascii 'a'),FValue (Ascii 'r'),FValue (Ascii 'y'),FValue (Ascii '1'),FValue (Ascii '2'),FValue (Ascii '8')]))]) env++decimal64_ = FName "decimal64"+stepDecimal64 = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 'd'),FValue (Ascii 'e'),FValue (Ascii 'c'),FValue (Ascii 'i'),FValue (Ascii 'm'),FValue (Ascii 'a'),FValue (Ascii 'l'),FValue (Ascii '6'),FValue (Ascii '4')]))]) env++decimal128_ = FName "decimal128"+stepDecimal128 = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 'd'),FValue (Ascii 'e'),FValue (Ascii 'c'),FValue (Ascii 'i'),FValue (Ascii 'm'),FValue (Ascii 'a'),FValue (Ascii 'l'),FValue (Ascii '1'),FValue (Ascii '2'),FValue (Ascii '8')]))]) env++float_formats_ = FName "float-formats"+stepFloat_formats = rewriteType "float-formats" []
+ cbs/Funcons/Core/Values/Primitive/Integers/Integers.hs view
@@ -0,0 +1,68 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Values/Primitive/Integers/Integers.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Values.Primitive.Integers.Integers where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    []++funcons = libFromList+    [("bounded-integers",StrictFuncon stepBounded_integers),("bounded-ints",StrictFuncon stepBounded_integers),("positive-integers",NullaryFuncon stepPositive_integers),("pos-ints",NullaryFuncon stepPositive_integers),("negative-integers",NullaryFuncon stepNegative_integers),("neg-ints",NullaryFuncon stepNegative_integers),("natural-numbers",NullaryFuncon stepNatural_numbers),("nats",NullaryFuncon stepNatural_numbers),("integer-negate",StrictFuncon stepInteger_negate),("int-neg",StrictFuncon stepInteger_negate),("integer-sequence",StrictFuncon stepInteger_sequence)]++bounded_integers_ fargs = FApp "bounded-integers" (fargs)+bounded_ints_ fargs = FApp "bounded-integers" (fargs)+stepBounded_integers fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "M") (TName "integers"),VPAnnotated (VPMetaVar "N") (TName "integers")] env+            rewriteTermTo (TSortInter (TApp "integers-from" [TVar "M"]) (TApp "integers-up-to" [TVar "N"])) env++positive_integers_ = FName "positive-integers"+pos_ints_ = FName "positive-integers"+stepPositive_integers = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "integers-from" [TFuncon (FValue (Nat 1))]) env++negative_integers_ = FName "negative-integers"+neg_ints_ = FName "negative-integers"+stepNegative_integers = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "integers-up-to" [TFuncon (FValue (Nat (-1)))]) env++natural_numbers_ = FName "natural-numbers"+nats_ = FName "natural-numbers"+stepNatural_numbers = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "integers-from" [TFuncon (FValue (Nat 0))]) env++integer_negate_ fargs = FApp "integer-negate" (fargs)+int_neg_ fargs = FApp "integer-negate" (fargs)+stepInteger_negate fargs =+    evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "N") (TName "integers")] env+            rewriteTermTo (TApp "integer-subtract" [TFuncon (FValue (Nat 0)),TVar "N"]) env++integer_sequence_ fargs = FApp "integer-sequence" (fargs)+stepInteger_sequence fargs =+    evalRules [rewrite1,rewrite2] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "M") (TName "integers"),VPAnnotated (VPMetaVar "N") (TName "integers")] env+            env <- sideCondition (SCEquality (TApp "is-greater" [TVar "M",TVar "N"]) (TName "false")) env+            rewriteTermTo (TSeq [TVar "M",TApp "integer-sequence" [TApp "integer-add" [TVar "M",TFuncon (FValue (Nat 1))],TVar "N"]]) env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "M") (TName "integers"),VPAnnotated (VPMetaVar "N") (TName "integers")] env+            env <- sideCondition (SCEquality (TApp "is-greater" [TVar "M",TVar "N"]) (TName "true")) env+            rewriteTermTo (TSeq []) env
+ cbs/Funcons/Core/Values/Primitive/Unit/Unit.hs view
@@ -0,0 +1,25 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Values/Primitive/Unit/Unit.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Values.Primitive.Unit.Unit where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    [("unit-type",DataTypeMemberss "unit-type" [] [DataTypeMemberConstructor "null-value" [] (Just [])])]++funcons = libFromList+    [("null-value",NullaryFuncon stepNull_value),("null",NullaryFuncon stepNull_value),("unit-type",NullaryFuncon stepUnit_type)]++null_value_ = FName "null-value"+null_ = FName "null-value"+stepNull_value = evalRules [rewrite1] []+    where rewrite1 = do+            let env = emptyEnv+            rewriteTermTo (TApp "datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 'n'),FValue (Ascii 'u'),FValue (Ascii 'l'),FValue (Ascii 'l'),FValue (Ascii '-'),FValue (Ascii 'v'),FValue (Ascii 'a'),FValue (Ascii 'l'),FValue (Ascii 'u'),FValue (Ascii 'e')]))]) env++unit_type_ = FName "unit-type"+stepUnit_type = rewriteType "unit-type" []
− cbs/Funcons/Core/Values/PrimitiveValues/Bits.hs 
@@ -1,60 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Values/Primitive values/bits.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Values.PrimitiveValues.Bits where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("bytes",NullaryFuncon stepBytes),("unsigned-bits-maximum",StrictFuncon stepUnsigned_bits_maximum),("signed-bits-maximum",StrictFuncon stepSigned_bits_maximum),("signed-bits-minimum",StrictFuncon stepSigned_bits_minimum),("is-in-signed-bits",StrictFuncon stepIs_in_signed_bits),("is-in-unsigned-bits",StrictFuncon stepIs_in_unsigned_bits)]--bytes_ = FName "bytes"-stepBytes = evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            rewriteTo (FApp "bits" (FTuple [FValue (Nat 8)]))--unsigned_bits_maximum_ fargs = FApp "unsigned-bits-maximum" (FTuple fargs)-stepUnsigned_bits_maximum fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "N") (TName "values")] env-            rewriteTermTo (TApp "integer-subtract" (TTuple [TApp "integer-power" (TTuple [TFuncon (FValue (Nat 2)),TVar "N"]),TFuncon (FValue (Nat 1))])) env--signed_bits_maximum_ fargs = FApp "signed-bits-maximum" (FTuple fargs)-stepSigned_bits_maximum fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "N") (TName "values")] env-            rewriteTermTo (TApp "integer-subtract" (TTuple [TApp "integer-power" (TTuple [TFuncon (FValue (Nat 2)),TApp "integer-subtract" (TTuple [TVar "N",TFuncon (FValue (Nat 1))])]),TFuncon (FValue (Nat 1))])) env--signed_bits_minimum_ fargs = FApp "signed-bits-minimum" (FTuple fargs)-stepSigned_bits_minimum fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "N") (TName "values")] env-            rewriteTermTo (TApp "integer-negate" (TTuple [TApp "integer-power" (TTuple [TFuncon (FValue (Nat 2)),TApp "integer-subtract" (TTuple [TVar "N",TFuncon (FValue (Nat 1))])])])) env--is_in_signed_bits_ fargs = FApp "is-in-signed-bits" (FTuple fargs)-stepIs_in_signed_bits fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "N") (TName "values"),VPAnnotated (VPMetaVar "I") (TName "values")] env-            rewriteTermTo (TApp "and" (TTuple [TApp "is-less-or-equal" (TTuple [TVar "I",TApp "signed-bits-maximum" (TTuple [TVar "N"])]),TApp "is-greater-or-equal" (TTuple [TVar "I",TApp "signed-bits-minimum" (TTuple [TVar "N"])])])) env--is_in_unsigned_bits_ fargs = FApp "is-in-unsigned-bits" (FTuple fargs)-stepIs_in_unsigned_bits fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "N") (TName "values"),VPAnnotated (VPMetaVar "I") (TName "values")] env-            rewriteTermTo (TApp "and" (TTuple [TApp "is-less-or-equal" (TTuple [TVar "I",TApp "unsigned-bits-maximum" (TTuple [TVar "N"])]),TApp "is-greater-or-equal" (TTuple [TVar "I",TFuncon (FValue (Nat 0))])])) env
− cbs/Funcons/Core/Values/PrimitiveValues/Booleans.hs 
@@ -1,126 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Values/Primitive values/booleans.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Values.PrimitiveValues.Booleans where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    [("booleans",DataTypeMembers [] [DataTypeConstructor "false" (TTuple []),DataTypeConstructor "true" (TTuple [])])]--funcons = libFromList-    [("not",StrictFuncon stepNot),("implies",StrictFuncon stepImplies),("and",StrictFuncon stepAnd),("or",StrictFuncon stepOr),("xor",StrictFuncon stepXor),("is-equal",StrictFuncon stepIs_equal),("booleans",NullaryFuncon stepBooleans),("false",NullaryFuncon stepFalse),("true",NullaryFuncon stepTrue)]---- |--- /booleans/ is the type of truth-values.---   /not(_)/ is logical negation.---   /and(...)/ is logical conjunction of a tuple of /booleans/ .---   /or(...)/ is logical disjunction of a tuple of /booleans/ .---   /xor(_,_)/ is exclusive disjunction of two /booleans/ .---   /implies(_,_)/ is logical implication between two /booleans/ .---   /is-equal(_,_)/ tests equality of arbitrary /values/ .-not_ fargs = FApp "not" (FTuple fargs)-stepNot fargs =-    evalRules [rewrite1,rewrite2] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [PADT "false" []] env-            rewriteTo (FName "true")-          rewrite2 = do-            let env = emptyEnv-            env <- vsMatch fargs [PADT "true" []] env-            rewriteTo (FName "false")--implies_ fargs = FApp "implies" (FTuple fargs)-stepImplies fargs =-    evalRules [rewrite1,rewrite2,rewrite3,rewrite4] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [PADT "false" [],PADT "false" []] env-            rewriteTo (FName "true")-          rewrite2 = do-            let env = emptyEnv-            env <- vsMatch fargs [PADT "false" [],PADT "true" []] env-            rewriteTo (FName "true")-          rewrite3 = do-            let env = emptyEnv-            env <- vsMatch fargs [PADT "true" [],PADT "true" []] env-            rewriteTo (FName "true")-          rewrite4 = do-            let env = emptyEnv-            env <- vsMatch fargs [PADT "true" [],PADT "false" []] env-            rewriteTo (FName "false")--and_ fargs = FApp "and" (FTuple fargs)-stepAnd fargs =-    evalRules [rewrite1,rewrite2,rewrite3] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [] env-            rewriteTo (FName "true")-          rewrite2 = do-            let env = emptyEnv-            env <- vsMatch fargs [PADT "false" [],VPAnnotated (VPSeqVar "B*" StarOp) (TName "booleans")] env-            rewriteTo (FName "false")-          rewrite3 = do-            let env = emptyEnv-            env <- vsMatch fargs [PADT "true" [],VPAnnotated (VPSeqVar "B*" StarOp) (TName "booleans")] env-            rewriteTermTo (TApp "and" (TTuple [TVar "B*"])) env--or_ fargs = FApp "or" (FTuple fargs)-stepOr fargs =-    evalRules [rewrite1,rewrite2,rewrite3] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [] env-            rewriteTo (FName "false")-          rewrite2 = do-            let env = emptyEnv-            env <- vsMatch fargs [PADT "true" [],VPAnnotated (VPSeqVar "B*" StarOp) (TName "booleans")] env-            rewriteTo (FName "true")-          rewrite3 = do-            let env = emptyEnv-            env <- vsMatch fargs [PADT "false" [],VPAnnotated (VPSeqVar "B*" StarOp) (TName "booleans")] env-            rewriteTermTo (TApp "or" (TTuple [TVar "B*"])) env--xor_ fargs = FApp "xor" (FTuple fargs)-stepXor fargs =-    evalRules [rewrite1,rewrite2,rewrite3,rewrite4] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [PADT "false" [],PADT "false" []] env-            rewriteTo (FName "false")-          rewrite2 = do-            let env = emptyEnv-            env <- vsMatch fargs [PADT "false" [],PADT "true" []] env-            rewriteTo (FName "true")-          rewrite3 = do-            let env = emptyEnv-            env <- vsMatch fargs [PADT "true" [],PADT "false" []] env-            rewriteTo (FName "true")-          rewrite4 = do-            let env = emptyEnv-            env <- vsMatch fargs [PADT "true" [],PADT "true" []] env-            rewriteTo (FName "false")--is_equal_ fargs = FApp "is-equal" (FTuple fargs)-stepIs_equal fargs =-    evalRules [rewrite1,rewrite2] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPMetaVar "V1",VPMetaVar "V2"] env-            env <- sideCondition (SCEquality (TVar "V1") (TVar "V2")) env-            rewriteTo (FName "true")-          rewrite2 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPMetaVar "V1",VPMetaVar "V2"] env-            env <- sideCondition (SCInequality (TVar "V1") (TVar "V2")) env-            rewriteTo (FName "false")--stepFalse = rewritten (ADTVal "false" [])--stepTrue = rewritten (ADTVal "true" [])--stepBooleans = rewriteType "booleans" []
− cbs/Funcons/Core/Values/PrimitiveValues/Numbers/IeeeFloats.hs 
@@ -1,49 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Values/Primitive values/Numbers/ieee-floats.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Values.PrimitiveValues.Numbers.IeeeFloats where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    [("ieee-formats",DataTypeMembers [] [DataTypeConstructor "binary32" (TTuple []),DataTypeConstructor "binary64" (TTuple []),DataTypeConstructor "binary128" (TTuple []),DataTypeConstructor "decimal64" (TTuple []),DataTypeConstructor "decimal128" (TTuple [])])]--funcons = libFromList-    [("quiet-not-a-number",StrictFuncon stepQuiet_not_a_number),("signals-not-a-number",StrictFuncon stepSignals_not_a_number),("positive-infinity",StrictFuncon stepPositive_infinity),("negative-infinity",StrictFuncon stepNegative_infinity),("ieee-formats",NullaryFuncon stepIeee_formats),("binary32",NullaryFuncon stepBinary32),("binary64",NullaryFuncon stepBinary64),("binary128",NullaryFuncon stepBinary128),("decimal64",NullaryFuncon stepDecimal64),("decimal128",NullaryFuncon stepDecimal128)]---- |--- An /ieee-floats/ is either one of four special values:---   	/quiet-not-a-number/ , /signals-not-a-number/ , /positive-infinity/ , /negative-infinity/ or is represented (internally) as a triple (S,C,Q).---   S is a sign bit: 0 denotes "+" and 1 denotes "-".---   C and Q determine the value.---     - In binary format the value is:  C x 2^Q---     - In decimal format the value is: C x 10^Q-quiet_not_a_number_ fargs = FApp "quiet-not-a-number" (FTuple fargs)-stepQuiet_not_a_number fargs =-    norule (FApp "quiet-not-a-number" (FTuple (map FValue fargs)))--signals_not_a_number_ fargs = FApp "signals-not-a-number" (FTuple fargs)-stepSignals_not_a_number fargs =-    norule (FApp "signals-not-a-number" (FTuple (map FValue fargs)))--positive_infinity_ fargs = FApp "positive-infinity" (FTuple fargs)-stepPositive_infinity fargs =-    norule (FApp "positive-infinity" (FTuple (map FValue fargs)))--negative_infinity_ fargs = FApp "negative-infinity" (FTuple fargs)-stepNegative_infinity fargs =-    norule (FApp "negative-infinity" (FTuple (map FValue fargs)))--stepBinary32 = rewritten (ADTVal "binary32" [])--stepBinary64 = rewritten (ADTVal "binary64" [])--stepBinary128 = rewritten (ADTVal "binary128" [])--stepDecimal64 = rewritten (ADTVal "decimal64" [])--stepDecimal128 = rewritten (ADTVal "decimal128" [])--stepIeee_formats = rewriteType "ieee-formats" []
− cbs/Funcons/Core/Values/PrimitiveValues/Numbers/Integers.hs 
@@ -1,22 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Values/Primitive values/Numbers/integers.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Values.PrimitiveValues.Numbers.Integers where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("integer-negate",StrictFuncon stepInteger_negate)]--integer_negate_ fargs = FApp "integer-negate" (FTuple fargs)-stepInteger_negate fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "I") (TName "values")] env-            rewriteTermTo (TApp "integer-subtract" (TTuple [TFuncon (FValue (Nat 0)),TVar "I"])) env
− cbs/Funcons/Core/Values/PrimitiveValues/Numbers/Rationals.hs 
@@ -1,30 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Values/Primitive values/Numbers/rationals.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Values.PrimitiveValues.Numbers.Rationals where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("negate",StrictFuncon stepNegate),("exponent-notation",StrictFuncon stepExponent_notation)]--negate_ fargs = FApp "negate" (FTuple fargs)-stepNegate fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "R") (TName "values")] env-            rewriteTermTo (TApp "subtract" (TTuple [TFuncon (FValue (Nat 0)),TVar "R"])) env--exponent_notation_ fargs = FApp "exponent-notation" (FTuple fargs)-stepExponent_notation fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "R") (TName "values"),VPAnnotated (VPMetaVar "I") (TName "values")] env-            rewriteTermTo (TApp "multiply" (TTuple [TVar "R",TApp "power" (TTuple [TFuncon (FValue (Nat 10)),TVar "I"])])) env
− cbs/Funcons/Core/Values/PrimitiveValues/Strings.hs 
@@ -1,28 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Values/Primitive values/strings.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Values.PrimitiveValues.Strings where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("ids",NullaryFuncon stepIds),("newline",NullaryFuncon stepNewline)]--ids_ = FName "ids"-stepIds = evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            rewriteTo (FName "strings")---- |--- /newline/ is the string containing only a line feed character ("LF" or "\n"). -newline_ = FName "newline"-stepNewline = evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            rewriteTo (FApp "to-string" (FTuple [FApp "ascii-character" (FTuple [FValue (String "\n")])]))
− cbs/Funcons/Core/Values/PrimitiveValues/UnicodeCharacters.hs 
@@ -1,38 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Values/Primitive values/unicode-characters.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Values.PrimitiveValues.UnicodeCharacters where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("unicode-character",StrictFuncon stepUnicode_character),("unicode-codes",NullaryFuncon stepUnicode_codes),("utf-32",StrictFuncon stepUtf_32)]--unicode_character_ fargs = FApp "unicode-character" (FTuple fargs)-stepUnicode_character fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPMetaVar "Str"] env-            env <- sideCondition (SCPatternMatch (TApp "string-to-list" (TTuple [TVar "Str"])) (VPMetaVar "Cs")) env-            env <- sideCondition (SCEquality (TApp "list-prefix" (TTuple [TFuncon (FValue (Nat 2)),TVar "Cs"])) (TFuncon (FValue (String "U+")))) env-            rewriteTermTo (TApp "unicode" (TTuple [TApp "hexadecimal-natural" (TTuple [TApp "list-to-string" (TTuple [TApp "list-suffix" (TTuple [TFuncon (FValue (Nat 2)),TVar "Cs"])])])])) env--unicode_codes_ = FName "unicode-codes"-stepUnicode_codes = evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            rewriteTo (FApp "bounded-integers" (FTuple [FValue (Nat 0),FApp "integer-subtract" (FTuple [FApp "integer-power" (FTuple [FValue (Nat 2),FValue (Nat 32)]),FValue (Nat 1)])]))--utf_32_ fargs = FApp "utf-32" (FTuple fargs)-stepUtf_32 fargs =-    evalRules [rewrite1] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPAnnotated (VPMetaVar "C") (TName "values")] env-            rewriteTermTo (TApp "integer-to-bits" (TTuple [TFuncon (FValue (Nat 32)),TApp "unicode-character-code" (TTuple [TVar "C"])])) env
− cbs/Funcons/Core/Values/PrimitiveValues/UnitType.hs 
@@ -1,33 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Values/Primitive values/unit-type.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Values.PrimitiveValues.UnitType where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    [("unit-type",DataTypeMembers [] [DataTypeConstructor "null" (TTuple [])])]--funcons = libFromList-    [("is-null",StrictFuncon stepIs_null),("unit-type",NullaryFuncon stepUnit_type),("null",NullaryFuncon stepNull)]---- |--- /is-null/ tests an arbitrary value to determine if it is equal to /null/ . -is_null_ fargs = FApp "is-null" (FTuple fargs)-stepIs_null fargs =-    evalRules [rewrite1,rewrite2] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [PADT "null" []] env-            rewriteTo (FName "true")-          rewrite2 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPMetaVar "V"] env-            env <- sideCondition (SCNotInSort (TVar "V") (TName "unit-type")) env-            rewriteTo (FName "false")--stepNull = rewritten (ADTVal "null" [])--stepUnit_type = rewriteType "unit-type" []
− cbs/Funcons/Core/Values/Types.hs 
@@ -1,30 +0,0 @@--- GeNeRaTeD fOr: ../../CBS/Funcons/Values/types.aterm-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Values.Types where--import Funcons.EDSL--entities = []--types = typeEnvFromList-    []--funcons = libFromList-    [("is-in-type",StrictFuncon stepIs_in_type)]---- |--- /is-in-type(V,T)/ tests membership of a value in a type. -is_in_type_ fargs = FApp "is-in-type" (FTuple fargs)-stepIs_in_type fargs =-    evalRules [rewrite1,rewrite2] []-    where rewrite1 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPMetaVar "V",VPMetaVar "T"] env-            env <- sideCondition (SCIsInSort (TVar "V") (TVar "T")) env-            rewriteTo (FName "true")-          rewrite2 = do-            let env = emptyEnv-            env <- vsMatch fargs [VPMetaVar "V",VPMetaVar "T"] env-            env <- sideCondition (SCNotInSort (TVar "V") (TVar "T")) env-            rewriteTo (FName "false")
+ cbs/Funcons/Core/Values/ValueTypes/ValueTypes.hs view
@@ -0,0 +1,81 @@+-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Values/Value-Types/Value-Types.cbs+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Values.ValueTypes.ValueTypes where++import Funcons.EDSL++import Funcons.Operations hiding (Values)+entities = []++types = typeEnvFromList+    []++funcons = libFromList+    [("is-in-type",StrictFuncon stepIs_in_type),("is",StrictFuncon stepIs_in_type),("cast-to-type",StrictFuncon stepCast_to_type),("cast",StrictFuncon stepCast_to_type),("is-defined",StrictFuncon stepIs_defined),("is-def",StrictFuncon stepIs_defined),("is-equal",StrictFuncon stepIs_equal),("is-eq",StrictFuncon stepIs_equal)]++is_in_type_ fargs = FApp "is-in-type" (fargs)+is_ fargs = FApp "is-in-type" (fargs)+stepIs_in_type fargs =+    evalRules [rewrite1,rewrite2] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values"),VPAnnotated (VPMetaVar "T'") (TName "types")] env+            env <- sideCondition (SCIsInSort (TVar "V") (TVar "T'")) env+            rewriteTermTo (TName "true") env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values"),VPAnnotated (VPMetaVar "T'") (TName "types")] env+            env <- sideCondition (SCIsInSort (TVar "V") (TSortComplement (TVar "T'"))) env+            rewriteTermTo (TName "false") env++cast_to_type_ fargs = FApp "cast-to-type" (fargs)+cast_ fargs = FApp "cast-to-type" (fargs)+stepCast_to_type fargs =+    evalRules [rewrite1,rewrite2] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values"),VPAnnotated (VPMetaVar "T'") (TName "types")] env+            env <- sideCondition (SCIsInSort (TVar "V") (TVar "T'")) env+            rewriteTermTo (TVar "V") env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values"),VPAnnotated (VPMetaVar "T'") (TName "types")] env+            env <- sideCondition (SCIsInSort (TVar "V") (TSortComplement (TVar "T'"))) env+            rewriteTermTo (TName "none") env++is_defined_ fargs = FApp "is-defined" (fargs)+is_def_ fargs = FApp "is-defined" (fargs)+stepIs_defined fargs =+    evalRules [rewrite1,rewrite2] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "defined-values")] env+            rewriteTermTo (TName "true") env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [PADT "none" []] env+            rewriteTermTo (TName "false") env++is_equal_ fargs = FApp "is-equal" (fargs)+is_eq_ fargs = FApp "is-equal" (fargs)+stepIs_equal fargs =+    evalRules [rewrite1,rewrite2,rewrite3,rewrite4] []+    where rewrite1 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "ground-values"),VPAnnotated (VPMetaVar "W") (TName "ground-values")] env+            env <- sideCondition (SCEquality (TVar "V") (TVar "W")) env+            rewriteTermTo (TName "true") env+          rewrite2 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "ground-values"),VPAnnotated (VPMetaVar "W") (TName "ground-values")] env+            env <- sideCondition (SCInequality (TVar "V") (TVar "W")) env+            rewriteTermTo (TName "false") env+          rewrite3 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TSortComplement (TName "ground-values")),VPAnnotated (VPMetaVar "W") (TName "values")] env+            rewriteTermTo (TName "false") env+          rewrite4 = do+            let env = emptyEnv+            env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values"),VPAnnotated (VPMetaVar "W") (TSortComplement (TName "ground-values"))] env+            rewriteTermTo (TName "false") env
funcons-tools.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                funcons-tools-version:             0.1.0.0+version:             0.2.0.1 synopsis:            A modular interpreter for executing funcons description:     The PLanCompS project has developed a component-based approach to formal semantics.@@ -10,7 +10,7 @@     of `fundamental constructs' called /funcons/.     .     Read more about the project here: <http://plancomps.org>.-    Read more about funcons and their specification in CBS here: <http://plancomps.dreamhosters.com/taosd2015/ TAOSD2015>.+    Read more about funcons and their specification in CBS here: <http://plancomps.dreamhosters.com/wp-content/uploads/2016/02/jlamp-16.pdf JLAMP2016>.     .     This package provides a collection of highly reusable funcons in "Funcons.Core",     an interpreter for these funcons and means for defining new funcons.@@ -34,161 +34,126 @@ copyright:           Copyright (C) 2015 L. Thomas van Binsbergen and Neil Sculthorpe category:            Compilers/Interpreters build-type:          Simple-stability:           experimental+stability:           unstable  -- extra-source-files: cabal-version:       >=1.10  library-  exposed-modules:      Funcons.EDSL, Funcons.Tools, Funcons.Core-  build-depends:       base >=4.3 && <4.9, text, containers, vector, bv, parsec, multiset, split, directory, mtl >= 2.0+  exposed-modules:        Funcons.EDSL+                        , Funcons.Tools+                         Funcons.Core+                        , Funcons.ValueOperations+                        , Funcons.Core.Manual+                        , Funcons.MetaProgramming +                        , Funcons.GLLParser+                        , Funcons.RunOptions+  build-depends:       base >=4.3 && <= 5+                      ,text+                      ,containers+                      ,vector>=0.12.0.0+                      ,bv >= 0.5+                      ,multiset+                      ,split+                      ,directory+                      ,mtl >= 2.0+                      ,gll >= 0.4.0.2+                      ,TypeCompose>=0.9.10+                      ,regex-applicative+                      ,random-strings+                      ,funcons-values   hs-source-dirs:      src, cbs, manual   default-language:    Haskell2010   other-extensions:    OverloadedStrings   ghc-options:         -fwarn-incomplete-patterns -fwarn-monomorphism-restriction -fwarn-unused-imports-  other-modules:       Funcons.MSOS, Funcons.Parser, Funcons.Lexer, Funcons.Substitution, Funcons.Patterns, Funcons.Entities, Funcons.Simulation, Funcons.RunOptions, Funcons.Exceptions, Funcons.Types, Funcons.Core.Library, Funcons.Printer,-           Funcons.Core.Computations.ControlFlow.Normal.Sequencing.LeftToRight,-           Funcons.Core.Computations.ControlFlow.Normal.Sequencing.Atomic,-           Funcons.Core.Computations.ControlFlow.Normal.Sequencing.Sequential,-           Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.VectorMap,-           Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.SetMap,-           Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.ListMap,-           Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.TupleMap,-           Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.MapMap,-           Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.MappingCollections.ListsMap,-           Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.MultisetFilter,-           Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.SetFilter,-           Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.MapFilter,-           Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.FilteringCollections.ListFilter,-           Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.ReducingCollections.ListFoldl,-           Funcons.Core.Computations.ControlFlow.Normal.Iterating.Definite.ReducingCollections.ListFoldr,-           Funcons.Core.Computations.ControlFlow.Normal.Iterating.Indefinite.While,-           Funcons.Core.Computations.ControlFlow.Normal.Iterating.Indefinite.DoWhile,-           Funcons.Core.Computations.ControlFlow.Normal.Choosing.IfThenElse,-           Funcons.Core.Computations.ControlFlow.Abnormal.Stuck,-           Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Control,-           Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Hole,-           Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.CallCc,-           Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Abort,-           Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Shift,-           Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Prompt,-           Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Reset,-           Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.ControlSignal,-           Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.Plug,-           Funcons.Core.Computations.ControlFlow.Abnormal.Continuations.ResumeSignal,-           Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.Thrown,-           Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.HandleThrown,-           Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.Finally,-           Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.Throw,-           Funcons.Core.Computations.ControlFlow.Abnormal.Throwing.HandleRecursively,-           Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Else,-           Funcons.Core.Computations.ControlFlow.Abnormal.Failing.CheckTrue,-           Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Fail,-           Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Signals,-           Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Dereference,-           Funcons.Core.Computations.ControlFlow.Abnormal.Failing.Failed,-           Funcons.Core.Computations.DataFlow.Interacting.PrintList,-           Funcons.Core.Computations.DataFlow.Interacting.Print,-           Funcons.Core.Computations.DataFlow.Interacting.StandardOut,-           Funcons.Core.Computations.DataFlow.Interacting.Read,-           Funcons.Core.Computations.DataFlow.Interacting.StandardIn,-           Funcons.Core.Computations.DataFlow.Effect,-           Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.AllocateMap,-           Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.GeneralAssign,-           Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.GeneralAssigned,-           Funcons.Core.Computations.DataFlow.Storing.GeneralVariables.AllocateVector,-           Funcons.Core.Computations.DataFlow.Storing.Stores,-           Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.CurrentValue,-           Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.Assigned,-           Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.AllocateInitialisedVariable,-           Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.AllocateVariable,-           Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.DeallocateVariable,-           Funcons.Core.Computations.DataFlow.Storing.SimpleVariables.Assign,-           Funcons.Core.Computations.DataFlow.Storing.Store,-           Funcons.Core.Computations.DataFlow.Storing.Variables,-           Funcons.Core.Computations.DataFlow.Linking.AllocateInitialisedLink,-           Funcons.Core.Computations.DataFlow.Linking.AllocateLink,-           Funcons.Core.Computations.DataFlow.Linking.FollowIfLink,-           Funcons.Core.Computations.DataFlow.Linking.LinkStore,-           Funcons.Core.Computations.DataFlow.Linking.Links,-           Funcons.Core.Computations.DataFlow.Linking.FollowLink,-           Funcons.Core.Computations.DataFlow.Linking.LinkStores,-           Funcons.Core.Computations.DataFlow.Linking.SetLink,-           Funcons.Core.Computations.DataFlow.Giving.Given,-           Funcons.Core.Computations.DataFlow.Giving.Give,-           Funcons.Core.Computations.DataFlow.Giving.GivenValue,-           Funcons.Core.Computations.DataFlow.Generating.AtomGenerator,-           Funcons.Core.Computations.DataFlow.Generating.FreshAtom,-           Funcons.Core.Computations.DataFlow.Generating.FreshBinder,-           Funcons.Core.Computations.DataFlow.Binding.Recursion.Recursive,-           Funcons.Core.Computations.DataFlow.Binding.Recursion.BindRecursively,-           Funcons.Core.Computations.DataFlow.Binding.Recursion.BoundRecursively,-           Funcons.Core.Computations.DataFlow.Binding.Bound,-           Funcons.Core.Computations.DataFlow.Binding.Environments,-           Funcons.Core.Computations.DataFlow.Binding.Scope,-           Funcons.Core.Computations.DataFlow.Binding.Accumulate,-           Funcons.Core.Computations.DataFlow.Binding.Bind,-           Funcons.Core.Computations.DataFlow.Binding.Environment,-           Funcons.Core.Computations.Sorts,-           Funcons.Core.Values.Types,-           Funcons.Core.Values.CompositeValues.Collections.DirectedGraphs,-           Funcons.Core.Values.CompositeValues.Collections.Tuples,-           Funcons.Core.Values.CompositeValues.AlgebraicDatatypeValues.Variants,-           Funcons.Core.Values.CompositeValues.AlgebraicDatatypeValues.Records,-           Funcons.Core.Values.CompositeValues.AlgebraicDatatypeValues.References,-           Funcons.Core.Values.PrimitiveValues.UnitType,-           Funcons.Core.Values.PrimitiveValues.UnicodeCharacters,-           Funcons.Core.Values.PrimitiveValues.Bits,-           Funcons.Core.Values.PrimitiveValues.Strings,-           Funcons.Core.Values.PrimitiveValues.Numbers.Integers,-           Funcons.Core.Values.PrimitiveValues.Numbers.Rationals,-           Funcons.Core.Values.PrimitiveValues.Numbers.IeeeFloats,-           Funcons.Core.Values.PrimitiveValues.Booleans,-           Funcons.Core.Abstractions.Closures.Close,-           Funcons.Core.Abstractions.Closures.Closure,-           Funcons.Core.Abstractions.Patterns.PatternPrefer,-           Funcons.Core.Abstractions.Patterns.Match,-           Funcons.Core.Abstractions.Patterns.Patterns,-           Funcons.Core.Abstractions.Patterns.PatternUnite,-           Funcons.Core.Abstractions.Patterns.PatternAny,-           Funcons.Core.Abstractions.Patterns.Case,-           Funcons.Core.Abstractions.Patterns.MatchLoosely,-           Funcons.Core.Abstractions.Patterns.PatternBind,-           Funcons.Core.Abstractions.IsGroundValue,-           Funcons.Core.Abstractions.Functions.Apply,-           Funcons.Core.Abstractions.Functions.BindingLambda,-           Funcons.Core.Abstractions.Functions.Supply,-           Funcons.Core.Abstractions.Functions.Curry,-           Funcons.Core.Abstractions.Functions.Lambda,-           Funcons.Core.Abstractions.Functions.Uncurry,-           Funcons.Core.Abstractions.Functions.PartialApply,-           Funcons.Core.Abstractions.Functions.Compose,-                        -- manual-                          Funcons.Core.Computations.DataFlow.Generating.AtomSeed-                        , Funcons.Core.Computations.DataFlow.Generating.NextAtom-                        , Funcons.Core.Values.Composite.Collections.Sets-                        , Funcons.Core.Values.Composite.Collections.Multisets-                        , Funcons.Core.Values.Composite.Collections.Lists-                        , Funcons.Core.Values.Composite.Collections.Maps-                        , Funcons.Core.Values.Composite.Collections.Vectors-                        , Funcons.Core.Values.Composite.AlgebraicDatatypeValues.AlgebraicDatatypes-                        , Funcons.Core.Values.Composite.Collections.TuplesBuiltin-                        , Funcons.Core.Values.Primitive.StringsBuiltin-                        , Funcons.Core.Values.Primitive.BitsBuiltin-                        , Funcons.Core.Values.Primitive.Numbers.IeeeFloatsBuiltin-                        , Funcons.Core.Values.Primitive.Numbers.Integers-                        , Funcons.Core.Values.Primitive.Numbers.RationalsBuiltin-                        , Funcons.Core.Values.Primitive.Atoms-                        , Funcons.Core.Values.Primitive.Characters-                        , Funcons.Core.Values.Primitive.BoolBuiltin-                        , Funcons.Core.Abstractions.Thunk-                        , Funcons.Core.Abstractions.Force-                        , Funcons.Core.Manual--+  other-modules:       +                    Funcons.MSOS, +                    Funcons.TypeSubstitution,+                    Funcons.Substitution, +                    Funcons.Parser, +                    Funcons.Patterns, +                    Funcons.Entities, +                    Funcons.Simulation, +                    Funcons.Exceptions, +                    Funcons.Types, +                    Funcons.Printer+                    -- generated+                     Funcons.Core.Library,+   Funcons.Core.Computations.Normal.Interacting.Interacting,+   Funcons.Core.Computations.Normal.Flowing.Flowing,+   Funcons.Core.Computations.Normal.Storing.Storing,+   Funcons.Core.Computations.Normal.Linking.Linking,+   Funcons.Core.Computations.Normal.Giving.Giving,+   Funcons.Core.Computations.Normal.Generating.Generating,+   Funcons.Core.Computations.Normal.Binding.Binding,+   Funcons.Core.Computations.Abnormal.Abrupting.Abrupting,+   Funcons.Core.Computations.Abnormal.Returning.Returning,+   Funcons.Core.Computations.Abnormal.Throwing.Throwing,+   Funcons.Core.Computations.Abnormal.Failing.Failing,+   Funcons.Core.Computations.Abnormal.Sticking,+   Funcons.Core.Computations.Abnormal.Breaking.Breaking,+   Funcons.Core.Computations.Abnormal.Continuing.Continuing,+   Funcons.Core.Computations.Abnormal.Controlling.Controlling,+   Funcons.Core.Values.ValueTypes.ValueTypes,+--   Funcons.Core.Values.Composite.Sets,+   Funcons.Core.Values.Composite.Bits.Bits,+   Funcons.Core.Values.Composite.Strings.Strings,+   Funcons.Core.Values.Composite.Datatypes.Datatypes,+   Funcons.Core.Values.Composite.Lists.Lists,+--   Funcons.Core.Values.Composite.Multisets,+   Funcons.Core.Values.Composite.Sequences.Sequences,+   Funcons.Core.Values.Composite.Variants.Variants,+   Funcons.Core.Values.Composite.Records.Records,+--   Funcons.Core.Values.Composite.Maps,+   Funcons.Core.Values.Composite.Vectors.Vectors,+   Funcons.Core.Values.Composite.Tuples.Tuples,+   Funcons.Core.Values.Composite.References.References,+   Funcons.Core.Values.Composite.Graphs.Graphs,+   Funcons.Core.Values.Primitive.Floats.Floats,+   Funcons.Core.Values.Primitive.Integers.Integers,+   Funcons.Core.Values.Primitive.Unit.Unit,+   Funcons.Core.Values.Primitive.Booleans.Booleans,+   Funcons.Core.Values.Primitive.Characters.Characters,+   Funcons.Core.Values.Abstraction.Functions.Functions,+   Funcons.Core.Values.Abstraction.Patterns.Patterns,+   Funcons.Core.Values.Abstraction.Generic.Generic,+   Funcons.Core.Values.Abstraction.Thunks.Thunks+                         -- manual+                         , Funcons.Core.Computations.Normal.GeneratingBuiltin+                         , Funcons.Core.Values.Composite.SetsBuiltin+                         , Funcons.Core.Values.Composite.MultisetsBuiltin+--                         , Funcons.Core.Values.Composite.ListsBuiltin+                         , Funcons.Core.Values.Composite.MapsBuiltin+--                         , Funcons.Core.Values.Composite.VectorsBuiltin+                         , Funcons.Core.Values.Composite.DatatypesBuiltin+--                         , Funcons.Core.Values.Composite.TuplesBuiltin+                         , Funcons.Core.Values.Primitive.StringsBuiltin+                         , Funcons.Core.Values.Primitive.BitsBuiltin+                         , Funcons.Core.Values.Primitive.FloatsBuiltin+                         , Funcons.Core.Values.Primitive.IntegersBuiltin+                         , Funcons.Core.Values.Primitive.Atoms+                         , Funcons.Core.Values.Primitive.CharactersBuiltin+                         , Funcons.Core.Values.Primitive.BoolBuiltin+                         , Funcons.Core.Values.TypesBuiltin+                         , Funcons.Core.Computations.TypesBuiltin  executable runfct-  main-is:             Main.hs-  other-extensions:    OverloadedStrings-  build-depends:       base >=4.3 && <4.9, text, containers, vector, bv, parsec, funcons-tools, multiset, split, directory, mtl >= 2.0-  hs-source-dirs:      src, manual, cbs-  default-language:    Haskell2010+   main-is:             Main.hs+   other-extensions:    OverloadedStrings+   build-depends:        base >=4.3 && <= 5+                        ,text+                        ,containers +                        ,vector+                        ,bv >= 0.5+                        ,funcons-tools+                        ,multiset+                        ,split+                        ,directory +                        ,mtl >= 2.0+                        ,gll >= 0.3.0.9+                        ,TypeCompose>=0.9.10+                        ,regex-applicative+                        ,random-strings+                        ,funcons-values+   hs-source-dirs:      src, manual, cbs+   default-language:    Haskell2010+ --  ghc-options:         -rtsopts
− manual/Funcons/Core/Abstractions/Force.hs 
@@ -1,15 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Abstractions.Force where--import Funcons.EDSL-import Funcons.Types--library = libFromList [-        ("force", StrictFuncon stepForce)-    ]--force_ = applyFuncon "force"-stepForce [Thunk f]  = compstep (stepTo f)-stepForce vs = sortErr (force_ (fvalues vs)) "cannot force a non-thunk"-
− manual/Funcons/Core/Abstractions/Thunk.hs 
@@ -1,20 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Abstractions.Thunk where--import Funcons.EDSL-import Funcons.Types--library = libFromList [-        ("thunk", NonStrictFuncon stepThunk) -    ,   ("thunks", StrictFuncon stepThunks)-    ]--thunk_ :: [Funcons] -> Funcons-thunk_ fargs = applyFuncon "thunk" fargs-stepThunk [f] = rewriteTo $ FValue $ Thunk f-stepThunk fs = sortErr (applyFuncon "thunk" fs) "thunk not applied to a single funcon"--stepThunks [ComputationType ct] = rewriteTo $ type_ $ Thunks ct-stepThunks vs = sortErr (applyFuncon "thunks" (fvalues vs)) -                    "thunks not applied to computation-type"
− manual/Funcons/Core/Computations/DataFlow/Generating/AtomSeed.hs 
@@ -1,8 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Generating.AtomSeed where--import Funcons.EDSL--library = libFromList [ ("atom-seed", NullaryFuncon (rewriteTo (FValue (Atom "0")))) ]-
− manual/Funcons/Core/Computations/DataFlow/Generating/NextAtom.hs 
@@ -1,14 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Computations.DataFlow.Generating.NextAtom where--import Funcons.EDSL--library = libFromList [-        ("next-atom", ValueOp next_atom)-    ]--next_atom [Atom k] = rewriteTo (FValue $ Atom (show (k'+1)))- where  k' :: Int-        k' = read k-next_atom vs = sortErr (applyFuncon "next-atom" (map FValue vs)) "next-atom not applied to an atom"
+ manual/Funcons/Core/Computations/Normal/GeneratingBuiltin.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Computations.Normal.GeneratingBuiltin where++import Funcons.EDSL+import Funcons.Operations hiding (Values,tobool)++import Data.Set (fromList)++library = libFromList [ +        ("initialise-generating", NonStrictFuncon stepInitialise_generating)+    ]++initialise_generating_ = FName "initialise-generating"+stepInitialise_generating fargs =+    evalRules [] [step1]+    where step1 = do+            let env = emptyEnv+            env <- lifted_fsMatch fargs [PMetaVar "P"] env+            env <- getMutPatt "used-atom-set" (VPWildCard) env+            putMut "used-atom-set" reserved_atoms+            stepTermTo (TVar "P") env+          reserved_atoms = Set (fromList [])+
+ manual/Funcons/Core/Computations/TypesBuiltin.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Computations.TypesBuiltin where++import Funcons.EDSL+import Funcons.Types+import Funcons.Operations (Types(ComputationTypes))++library = libFromList [+    ("computation-types", NullaryFuncon stepComputation_Types)+  ]++computation_types_ = applyFuncon "computation-types"+stepComputation_Types = rewritten $ typeVal ComputationTypes
manual/Funcons/Core/Manual.hs view
@@ -1,82 +1,74 @@ module Funcons.Core.Manual (     Funcons.Core.Manual.library-    , module Funcons.Core.Computations.DataFlow.Generating.AtomSeed -    , module Funcons.Core.Computations.DataFlow.Generating.NextAtom -    , module Funcons.Core.Values.Composite.Collections.Sets -    , module Funcons.Core.Values.Composite.Collections.Multisets -    , module Funcons.Core.Values.Composite.Collections.Lists -    , module Funcons.Core.Values.Composite.Collections.Maps -    , module Funcons.Core.Values.Composite.Collections.Vectors -    , module Funcons.Core.Values.Composite.AlgebraicDatatypeValues.AlgebraicDatatypes +    , module Funcons.Core.Computations.Normal.GeneratingBuiltin+    , module Funcons.Core.Values.Composite.SetsBuiltin +    , module Funcons.Core.Values.Composite.MultisetsBuiltin +--    , module Funcons.Core.Values.Composite.ListsBuiltin +    , module Funcons.Core.Values.Composite.MapsBuiltin +--    , module Funcons.Core.Values.Composite.VectorsBuiltin+    , module Funcons.Core.Values.Composite.DatatypesBuiltin      , module Funcons.Core.Values.Primitive.StringsBuiltin      , module Funcons.Core.Values.Primitive.BitsBuiltin -    , module Funcons.Core.Values.Primitive.Numbers.Integers -    , module Funcons.Core.Values.Primitive.Numbers.IeeeFloatsBuiltin -    , module Funcons.Core.Values.Primitive.Numbers.RationalsBuiltin +    , module Funcons.Core.Values.Primitive.IntegersBuiltin +    , module Funcons.Core.Values.Primitive.FloatsBuiltin      , module Funcons.Core.Values.Primitive.Atoms -    , module Funcons.Core.Values.Primitive.Characters -    , module Funcons.Core.Abstractions.Thunk -    , module Funcons.Core.Abstractions.Force -    , module Funcons.Core.Values.Composite.Collections.TuplesBuiltin +    , module Funcons.Core.Values.Primitive.BoolBuiltin+    , module Funcons.Core.Values.Primitive.CharactersBuiltin +--    , module Funcons.Core.Values.Composite.TuplesBuiltin +    , module Funcons.Core.Values.TypesBuiltin     )where import Funcons.EDSL -import Funcons.Core.Computations.DataFlow.Generating.AtomSeed hiding (library)-import Funcons.Core.Computations.DataFlow.Generating.NextAtom hiding (library)-import Funcons.Core.Values.Composite.Collections.Sets hiding (library)-import Funcons.Core.Values.Composite.Collections.Multisets hiding (library)-import Funcons.Core.Values.Composite.Collections.Lists hiding (library)-import Funcons.Core.Values.Composite.Collections.Maps hiding (library)-import Funcons.Core.Values.Composite.Collections.Vectors hiding (library)-import Funcons.Core.Values.Composite.AlgebraicDatatypeValues.AlgebraicDatatypes hiding (library)+import Funcons.Core.Values.Composite.SetsBuiltin hiding (library)+import Funcons.Core.Values.Composite.MultisetsBuiltin hiding (library)+--import Funcons.Core.Values.Composite.ListsBuiltin hiding (library)+import Funcons.Core.Values.Composite.MapsBuiltin hiding (library)+--import Funcons.Core.Values.Composite.VectorsBuiltin hiding (library)+import Funcons.Core.Values.Composite.DatatypesBuiltin hiding (library) import Funcons.Core.Values.Primitive.StringsBuiltin hiding (library) import Funcons.Core.Values.Primitive.BitsBuiltin hiding (library)-import Funcons.Core.Values.Primitive.Numbers.Integers hiding (library)-import Funcons.Core.Values.Primitive.Numbers.IeeeFloatsBuiltin hiding (library)-import Funcons.Core.Values.Primitive.Numbers.RationalsBuiltin hiding (library)+import Funcons.Core.Values.Primitive.IntegersBuiltin hiding (library)+import Funcons.Core.Values.Primitive.FloatsBuiltin hiding (library) import Funcons.Core.Values.Primitive.Atoms hiding (library)-import Funcons.Core.Values.Primitive.Characters hiding (library)-import Funcons.Core.Abstractions.Thunk hiding (library)-import Funcons.Core.Abstractions.Force hiding (library)-import Funcons.Core.Values.Composite.Collections.TuplesBuiltin hiding (library)+import Funcons.Core.Values.Primitive.BoolBuiltin hiding (library)+import Funcons.Core.Values.Primitive.CharactersBuiltin hiding (library)+--import Funcons.Core.Values.Composite.TuplesBuiltin hiding (library) -import qualified Funcons.Core.Computations.DataFlow.Generating.AtomSeed-import qualified Funcons.Core.Computations.DataFlow.Generating.NextAtom-import qualified Funcons.Core.Values.Composite.Collections.Sets-import qualified Funcons.Core.Values.Composite.Collections.Multisets-import qualified Funcons.Core.Values.Composite.Collections.Lists-import qualified Funcons.Core.Values.Composite.Collections.Maps-import qualified Funcons.Core.Values.Composite.Collections.Vectors-import qualified Funcons.Core.Values.Composite.AlgebraicDatatypeValues.AlgebraicDatatypes+import qualified Funcons.Core.Computations.Normal.GeneratingBuiltin+import qualified Funcons.Core.Values.Composite.SetsBuiltin+import qualified Funcons.Core.Values.Composite.MultisetsBuiltin+--import qualified Funcons.Core.Values.Composite.ListsBuiltin+import qualified Funcons.Core.Values.Composite.MapsBuiltin+--import qualified Funcons.Core.Values.Composite.VectorsBuiltin+import qualified Funcons.Core.Values.Composite.DatatypesBuiltin import qualified Funcons.Core.Values.Primitive.StringsBuiltin import qualified Funcons.Core.Values.Primitive.BitsBuiltin-import qualified Funcons.Core.Values.Primitive.Numbers.Integers-import qualified Funcons.Core.Values.Primitive.Numbers.IeeeFloatsBuiltin-import qualified Funcons.Core.Values.Primitive.Numbers.RationalsBuiltin+import qualified Funcons.Core.Values.Primitive.IntegersBuiltin+import qualified Funcons.Core.Values.Primitive.FloatsBuiltin import qualified Funcons.Core.Values.Primitive.Atoms-import qualified Funcons.Core.Values.Primitive.Characters-import qualified Funcons.Core.Abstractions.Thunk-import qualified Funcons.Core.Abstractions.Force-import qualified Funcons.Core.Values.Composite.Collections.TuplesBuiltin+import qualified Funcons.Core.Values.Primitive.BoolBuiltin+import qualified Funcons.Core.Values.Primitive.CharactersBuiltin+--import qualified Funcons.Core.Values.Composite.TuplesBuiltin+import qualified Funcons.Core.Values.TypesBuiltin+import qualified Funcons.Core.Computations.TypesBuiltin  library = libUnions     [-    Funcons.Core.Computations.DataFlow.Generating.AtomSeed.library-    , Funcons.Core.Computations.DataFlow.Generating.NextAtom.library-    , Funcons.Core.Values.Composite.Collections.Sets.library-    , Funcons.Core.Values.Composite.Collections.Multisets.library-    , Funcons.Core.Values.Composite.Collections.Lists.library-    , Funcons.Core.Values.Composite.Collections.Maps.library-    , Funcons.Core.Values.Composite.Collections.Vectors.library-    , Funcons.Core.Values.Composite.AlgebraicDatatypeValues.AlgebraicDatatypes.library+      Funcons.Core.Computations.Normal.GeneratingBuiltin.library+    , Funcons.Core.Values.Composite.SetsBuiltin.library+    , Funcons.Core.Values.Composite.MultisetsBuiltin.library+--    , Funcons.Core.Values.Composite.ListsBuiltin.library+    , Funcons.Core.Values.Composite.MapsBuiltin.library+--    , Funcons.Core.Values.Composite.VectorsBuiltin.library+    , Funcons.Core.Values.Composite.DatatypesBuiltin.library     , Funcons.Core.Values.Primitive.StringsBuiltin.library     , Funcons.Core.Values.Primitive.BitsBuiltin.library-    , Funcons.Core.Values.Primitive.Numbers.Integers.library-    , Funcons.Core.Values.Primitive.Numbers.IeeeFloatsBuiltin.library-    , Funcons.Core.Values.Primitive.Numbers.RationalsBuiltin.library+    , Funcons.Core.Values.Primitive.IntegersBuiltin.library+    , Funcons.Core.Values.Primitive.FloatsBuiltin.library     , Funcons.Core.Values.Primitive.Atoms.library-    , Funcons.Core.Values.Primitive.Characters.library-    , Funcons.Core.Abstractions.Thunk.library-    , Funcons.Core.Abstractions.Force.library-    , Funcons.Core.Values.Composite.Collections.TuplesBuiltin.library+    , Funcons.Core.Values.Primitive.BoolBuiltin.library+    , Funcons.Core.Values.Primitive.CharactersBuiltin.library+--    , Funcons.Core.Values.Composite.TuplesBuiltin.library+    , Funcons.Core.Values.TypesBuiltin.library+    , Funcons.Core.Computations.TypesBuiltin.library     ]
− manual/Funcons/Core/Values/Composite/AlgebraicDatatypeValues/AlgebraicDatatypes.hs 
@@ -1,28 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Values.Composite.AlgebraicDatatypeValues.AlgebraicDatatypes where--import Funcons.EDSL-import Funcons.Types--import Data.Text (unpack, pack)--library = libFromList [-        ("algebraic-datatype", ValueOp evalADT)-    ,   ("algebraic-datatype-constructor", ValueOp evalADT_Con)-    ,   ("algebraic-datatype-value", ValueOp getADT_Values)-    ]--evalADT [Atom con, v] = rewritten $ ADTVal (pack con) (tuple_unval v)-evalADT vs = sortErr (applyFuncon "algebraic-datatype" (fvalues vs))-                    "algebraic-datatype not applied to correct arguments"--evalADT_Con [ADTVal con _] = rewritten $ Atom (unpack con)-evalADT_Con vs           = sortErr (applyFuncon "algebraid-datatype-constructor" (fvalues vs)) -                             "algebraic-datatype-constructor not applied to an ADT"--getADT_Values [ADTVal _ vs] = rewritten (safe_tuple_val vs)-getADT_Values vs = sortErr (applyFuncon "algebraic-datatype-value" (fvalues vs)) -                            "algebraic-datatype-value not applied to an ADT"--
− manual/Funcons/Core/Values/Composite/Collections/Lists.hs 
@@ -1,96 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Values.Composite.Collections.Lists where--import Funcons.EDSL-import Funcons.Types-import Funcons.Core.Values.Primitive.BoolBuiltin--import Data.List--library = libFromList [-        ("list-length", ValueOp stepList_Length)-    ,   ("list", ValueOp stepList)-    ,   ("tail", ValueOp stepTail)-    ,   ("head", ValueOp stepHead)-    ,   ("cons", ValueOp stepCons)-    ,   ("nil", NullaryFuncon (rewritten (List [])))-    ,   ("is-in-list", ValueOp stepIs_In_List)-    ,   ("is-nil", ValueOp stepIs_Nil)-    ,   ("list-append", ValueOp list_append_op)-    ,   ("list-to-tuple", ValueOp stepList_To_Tuple)-    ,   ("list-intersperse", ValueOp stepList_Intersperse)-    ,   ("list-repeat", ValueOp stepList_Repeat)-    ,   ("list-reverse", ValueOp stepList_Reverse)-    ,   ("list-suffix", ValueOp stepList_Suffix)-    ,   ("list-prefix", ValueOp stepList_Prefix)-    ]--stepList vs = rewriteTo $ FValue $ List vs--stepList_Length [List l] = rewriteTo $ int_ (length l)-stepList_Length v = sortErr (applyFuncon "list-length" (fvalues v))-                        "list-length not applied to a list"--stepHead [List []]              = partialOp (applyFuncon "head" [FValue $ List []]) "head of empty list"-stepHead [List (h:_)]           = rewriteTo $ FValue h-stepHead v                      = sortErr (applyFuncon "head" (fvalues v)) "head not applied to a list"--stepTail [List []]              = partialOp (applyFuncon "tail" [FValue $ List []]) "tail of empty list"-stepTail [List (_:tl)]          = rewriteTo $ FValue $ List tl-stepTail v                      = sortErr (applyFuncon "tail" (fvalues v))-                                    "tail not applied to a list"---- | Funcons for inserting a value to a list.-cons_ :: [Funcons] -> Funcons-cons_ = applyFuncon "cons"---- | Funcons representing the empty list.-nil_ :: Funcons-nil_  = applyFuncon "nil" []--stepCons [h, List t]   = rewriteTo $ FValue $ List (h:t)-stepCons v             = sortErr (applyFuncon "cons" (fvalues v))-                                            "cons should add a value to a list of values"-stepIs_In_List [e, List xs] = rewriteTo $ FValue $ tobool (e `elem` xs)-stepIs_In_List v                = sortErr (applyFuncon "is-in-list" (fvalues v))-                                        "sort check: is-in-list(X,XS)"--stepIs_Nil [List vs] = rewriteTo $ FValue $ tobool (null vs)-stepIs_Nil v         = sortErr (applyFuncon "is-nil" (fvalues v))-                                     "is-nil not applied to a list"-stepList_Suffix [vn, List ls]-    | Nat n <- upcastNaturals vn = rewriteTo $ listval (drop (fromInteger n) ls)-stepList_Suffix vn = sortErr (applyFuncon "list-suffix" (fvalues vn)) "sort check"--stepList_Prefix [vn, List ls]-    | Nat n <- upcastNaturals vn = rewriteTo $ listval (take (fromInteger n) ls)-stepList_Prefix vn = sortErr (applyFuncon "list-prefix" (fvalues vn)) "sort check"--list_to_tuple_ :: [Funcons] -> Funcons-list_to_tuple_ = applyFuncon "list-to-tuple" -stepList_To_Tuple vs            = list_to_tuple_op vs--stepList_Intersperse [v,List l] = rewriteTo $ listval (intersperse v l)-stepList_Intersperse v          = sortErr (applyFuncon "list-intersperse" (fvalues v)) "list-intersperse not applied to a value and a list"--stepList_Repeat [m,v]-    | Nat n <- upcastNaturals m = rewriteTo $ listval (replicate (fromInteger n) v)-stepList_Repeat v               = sortErr (applyFuncon "list-repeat" (fvalues v)) "list-repeat not applied to a nat and a value"--stepList_Reverse [List l]       = rewriteTo $ listval (reverse l)-stepList_Reverse v              = sortErr (applyFuncon "list-reverse" (fvalues v)) "list-reverse not applied to a list"---list_to_tuple_op [List xs] = rewriteTo $ FValue $ safe_tuple_val xs-list_to_tuple_op v = sortErr (applyFuncon "list-to-tuple" (fvalues v))-                         "list-to-tuple not applied to list"--list_append_op :: [Values] -> Rewrite Rewritten-list_append_op vs | all isList_ vs = rewriteTo $ FValue $  List (concatMap toList vs)-                  | otherwise = sortErr (applyFuncon "list-append" [FValue $ safe_tuple_val vs])-                                    "list-append not applied to a sequence of lists"- where  toList (List l) = l-        toList _ = error "list-append not applied to lists"-        isList_ (List _) = True-        isList_ _        = False
− manual/Funcons/Core/Values/Composite/Collections/Maps.hs 
@@ -1,103 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Values.Composite.Collections.Maps where--import Funcons.EDSL-import Funcons.Types-import Funcons.Core.Values.Primitive.BoolBuiltin--import qualified Data.Set as S-import qualified Data.Map as M--library = libFromList [-        ("map-empty", NullaryFuncon (rewritten (Map M.empty)))-    ,   ("lookup", ValueOp lookup_op)-    ,   ("domain", ValueOp stepDomain)-    ,   ("map-override", ValueOp stepMapOverride)-    ,   ("map-unite", ValueOp unite_maps)-    ,   ("map-delete", ValueOp stepMapDelete)-    ,   ("map-to-list", ValueOp stepMapToList)-    ,   ("is-map-empty", ValueOp stepIsMapEmpty)-    ,   ("list-to-map", ValueOp list_to_map_op)-    ,   ("set-to-map", ValueOp set_to_map_op)-    ]--is_map_empty = applyFuncon "is-map-empty"-stepIsMapEmpty [Map m] = rewriteTo $ FValue $ tobool (null m)-stepIsMapEmpty vs = sortErr (is_map_empty (fvalues vs)) "is-map-empty not applied to a map"--map_to_list = applyFuncon "map-to-list"-stepMapToList [Map m] = rewriteTo $ FValue $ List $ map toTup $ M.assocs m-    where toTup (k,v) = NonEmptyTuple k v []-stepMapToList vs = sortErr (map_to_list (fvalues vs)) "map-to-list not applied to a map"--map_delete = applyFuncon "map-delete"-stepMapDelete [Map m, Set s] = rewriteTo $ FValue $ Map (foldr M.delete m s)-stepMapDelete vs = sortErr (map_delete (fvalues vs))-                        "map-delete not applied to a map and set of values"---- | --- Computes the union over a sequence of maps.--- If the maps do not have disjoint domains a failure signal is raised.-map_unite_ = FApp "map-unite" . FTuple--unite_maps vs-  | not (all isMap vs) = sortErr (map_unite_ (fvalues vs)) -                            "map-unite not applied to a sequence of maps"-  | otherwise = -        let maps = map toMap vs-            domains = map (M.keysSet) maps-         in if S.null (foldr S.intersection S.empty domains)-                then rewriteTo $ FValue $ Map $ M.unions maps-                else partialOp (map_unite_ (fvalues vs)) -                        "map-unite not applied to maps with disjoint domains"- where  toMap (Map m) = m-        toMap _       = error "unite-maps, toMap"-        isMap (Map m) = True-        isMap _       = False--lookup_ = applyFuncon "lookup"--lookup_op v@[k, Map m] = case M.lookup k m of-                            Nothing -> partialOp (lookup_ (fvalues v)) "failed to lookup"-                            Just v  -> rewriteTo $ FValue v-lookup_op vs = sortErr (lookup_ (fvalues vs)) "lookup not given a key and a map"---- | --- Computes the left-biased union over two maps.-map_override_ :: [Funcons] -> Funcons-map_override_ = applyFuncon "map-override"-stepMapOverride [x,y]  = rewriteTo =<< map_override_op x y-    where-    map_override_op :: Values -> Values -> Rewrite Funcons-    map_override_op (Map m1) (Map m2) = return (FValue $ Map $ M.union m1 m2)-    map_override_op v1 v2 = sortErr (applyFuncon "map-override" [FValue v1, FValue v2]) "map-override not applied to maps"-stepMapOverride vs = sortErr (applyFuncon "map-override" (fvalues vs)) "map-override(M1,M2)"--stepDomain m  = rewriteTo =<< domain m-    where-    domain :: [Values] -> Rewrite Funcons-    domain [Map m] = return $ FValue $ Set $ S.fromList $ M.keys m-    domain vs = sortErr (applyFuncon "domain" (fvalues vs)) "domain not given a map"--set_to_map = applyFuncon "set-to-map"-set_to_map_op :: [Values] -> Rewrite Rewritten-set_to_map_op [Set vs]-    | all isPair_ vs = rewriteTo $ FValue $ Map $ M.fromList $ map unPair $ S.toList vs- where isPair_ (NonEmptyTuple _ _ []) = True-       isPair_ _ = False-       unPair (NonEmptyTuple k v []) = (k,v)-       unPair _ = error "set-to-map not applied to a set of key-value pairs"-set_to_map_op vs = sortErr (set_to_map (fvalues vs))-    "set-to-map not applied to a set of key-value pairs"--list_to_map = applyFuncon "list-to-map"-list_to_map_op :: [Values] -> Rewrite Rewritten-list_to_map_op [List vs]-    | all isPair_ vs = rewriteTo $ FValue $ Map $ M.fromList $ map unPair $ vs- where isPair_ (NonEmptyTuple _ _ []) = True-       isPair_ _ = False-       unPair (NonEmptyTuple k v []) = (k,v)-       unPair _ = error "set-to-map not applied to a set of key-value pairs"-list_to_map_op vs = sortErr (list_to_map (fvalues vs))-    "list-to-map not applied a lit of key-value pairs"
− manual/Funcons/Core/Values/Composite/Collections/Multisets.hs 
@@ -1,56 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Values.Composite.Collections.Multisets where--import Funcons.EDSL-import Funcons.Core.Values.Primitive.BoolBuiltin--import qualified Data.MultiSet as MS--library = libFromList [-        ("multiset-empty", NullaryFuncon (rewritten (Multiset MS.empty)))-    ,   ("sets-to-multisets", ValueOp stepSetsToMultisets)-    ,   ("multiset-to-set", ValueOp stepMultisetToSet)-    ,   ("multiset-occurrences", ValueOp stepMultisetOccurrences)-    ,   ("multiset-insert", ValueOp stepMultisetInsert)-    ,   ("multiset-delete", ValueOp stepMultisetDelete)-    ,   ("is-submultiset", ValueOp stepIsSubMultiset)-    ]--is_sub_multiset = applyFuncon "is-sub-multiset"-stepIsSubMultiset [Multiset s1, Multiset s2] = -    rewriteTo $ FValue $ tobool (s1 `MS.isSubsetOf`s2)-stepIsSubMultiset vs = sortErr (is_sub_multiset (map FValue vs)) -                            "is-sub-multiset not applied to two multisets"--multiset_delete = applyFuncon "multiset-delete"-stepMultisetDelete [Multiset ms, v, vn]-    | Nat n <- upcastNaturals vn = rewriteTo $ FValue $ Multiset (MS.deleteMany v (fromInteger n) ms)-stepMultisetDelete vs = sortErr (multiset_delete (map FValue vs)) -    "multiset-delete not applied to a multiset, value and natural number"--multiset_insert = applyFuncon "multiset-insert"-stepMultisetInsert [v, vn, Multiset ms]-    | Nat n <- upcastNaturals vn = rewriteTo $ FValue $ Multiset (MS.insertMany v (fromInteger n) ms)-stepMultisetInsert vs = sortErr (multiset_insert (map FValue vs))-    "multiset-insert not applied to a value, natural number and multiset"--multiset_occurrences = applyFuncon "multiset-occurrences"-stepMultisetOccurrences [v, Multiset ms] = rewriteTo $ int_ (MS.occur v ms)-stepMultisetOccurrences vs = sortErr (multiset_occurrences (map FValue vs))-    "multiset-occurrences not applied to a value and a multiset"--multiset_to_set = applyFuncon "multiset-to-set"-stepMultisetToSet [Multiset ms] = rewriteTo $ FValue $ Set (MS.toSet ms)-stepMultisetToSet vs = sortErr (multiset_to_set (map FValue vs))-    "multiset-to-set not applied to a multiset"--sets_to_multiset = applyFuncon "sets-to-multiset"-stepSetsToMultisets vs-    | all isSet_ vs = rewriteTo $ FValue $ Multiset (MS.unions (map toMS vs))-    | otherwise = sortErr (sets_to_multiset (map FValue vs))-        "sets-to-multiset not applied to sets"-    where   isSet_ (Set _)  = True-            isSet_ _        = False-            toMS (Set s)    = MS.fromSet s-            toMS _          = error "sets-to-multiset"
− manual/Funcons/Core/Values/Composite/Collections/Sets.hs 
@@ -1,85 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Values.Composite.Collections.Sets where--import Funcons.EDSL-import Funcons.Core.Values.Primitive.BoolBuiltin--import qualified Data.Set as S--library = libFromList [-        ("set", ValueOp stepSet)-    ,   ("set-empty", NullaryFuncon (rewritten (Set S.empty)))-    ,   ("set-insert", ValueOp stepSet_Insert)-    ,   ("set-unite", ValueOp set_unite_op)-    ,   ("set-intersect", ValueOp set_intersect_op)-    ,   ("set-difference", ValueOp set_difference_op)-    ,   ("set-size", ValueOp set_size_op)-    ,   ("is-in-set", ValueOp stepIsInSet)-    ,   ("some-element", ValueOp stepSome_Element)-    ,   ("is-set-empty", ValueOp is_set_empty_op)-    ,   ("set-to-list", ValueOp stepSetToList)-    ,   ("list-to-set", ValueOp stepList_To_Set)-    ,   ("is-subset", ValueOp stepIs_Subset)-    ]--set_to_list = applyFuncon "set-to-list"-stepSetToList [Set s] = rewriteTo $ FValue $ List (S.toList s)-stepSetToList vs = sortErr (set_to_list (map FValue vs)) "set-to-list not applied to a set"--is_set_empty = applyFuncon "is-set-empty"-is_set_empty_op [Set s] = rewriteTo $ FValue $ tobool (null s)-is_set_empty_op vs = sortErr (is_set_empty (map FValue vs)) "is-set-empty not applied to a set"--set_size = applyFuncon "set-size"-set_size_op [Set s] = rewriteTo $ int_ (S.size s) -set_size_op vs = sortErr (set_size (map FValue vs)) "set-size not applied to a set"--set_intersect = applyFuncon "set-intersect"-set_intersect_op [] = rewriteTo $ FValue $ Set S.empty-set_intersect_op vs-    | all isSet_ vs = rewriteTo $ FValue $ Set (foldr1 S.intersection (map toSet vs))-    | otherwise = sortErr (set_intersect (map FValue vs)) "set-intersect not applied to sets"-    where   isSet_ (Set _) = True-            isSet_ _       = False-            toSet (Set s)  = s-            toSet _        = error "set-intersect toSet"--set_difference = applyFuncon "set-difference"-set_difference_op [Set s1, Set s2] = rewriteTo $ FValue $ Set (s1 `S.difference` s2)-set_difference_op vs = sortErr (set_difference (map FValue vs)) -                            "set-difference not applied to two sets"--some_element = applyFuncon "some-element"-stepSome_Element [Set s] | not (null s) = rewriteTo $ FValue $ S.findMax s-stepSome_Element vs = sortErr (some_element (map FValue vs)) "some-element not applied to a set"--is_subset = applyFuncon "is-subset"-stepIs_Subset [Set s1, Set s2] = rewriteTo $ FValue $ tobool (s1 `S.isSubsetOf` s2)-stepIs_Subset vs = sortErr (is_subset (map FValue vs)) "is-subset not applied to two sets"--stepSet :: [Values] -> Rewrite Rewritten -stepSet vs = rewriteTo $ FValue $ Set (S.fromList vs)--stepIsInSet [e,Set s] = rewriteTo $ FValue $ tobool (e `S.member` s) --stepIsInSet vs = sortErr (applyFuncon "is-in-set" (map FValue vs)) "sort check: is-in-set(_,_)"--set_unite = applyFuncon "set-unite"-set_unite_op :: [Values] -> Rewrite Rewritten -set_unite_op vs | all isSet_ vs = rewriteTo $ FValue $ Set $ S.unions $ map unSet vs-                | otherwise = sortErr (set_unite (map FValue vs)) "set-unite not applied to sets"-    where   isSet_ (Set s) = True-            isSet_ _       = False-            unSet (Set s) = s-            unSet _       = error "set-unite not applied to sets only"---set_insert = applyFuncon "set-insert"-stepSet_Insert [e,Set s] = rewriteTo $ FValue $ Set (e `S.insert` s)-stepSet_Insert vs        = sortErr (set_insert (map FValue vs)) "sort check: set-insert(_,_)"--list_to_set = applyFuncon "list-to-set"-stepList_To_Set [List l]        = rewriteTo $ FValue $ Set $ S.fromList l-stepList_To_Set vs              = sortErr (list_to_set (map FValue vs)) "list-to-set not applied to a list"-
− manual/Funcons/Core/Values/Composite/Collections/TuplesBuiltin.hs 
@@ -1,28 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Values.Composite.Collections.TuplesBuiltin where--import Funcons.EDSL-import Funcons.Types--library = libFromList [-        ("discard-empty-tuples", ValueOp discard_empty_tuples_op)-    ,   ("tuple-index", ValueOp stepTupleIndex)-    ]--discard_empty_tuples_ = FApp "discard-empty-tuples" . FTuple-discard_empty_tuples_op vs = rewriteTo $ FValue $ safe_tuple_val (filter (/= EmptyTuple) vs)---- | /tuple-index(_,N)/ selects the /N/th component of a tuple.---   e.g. /tuple-index((true,"hello",'B'),2)/ = `"hello"-tuple_index_ :: [Funcons] -> Funcons-tuple_index_ = applyFuncon "tuple-index"--stepTupleIndex args@[NonEmptyTuple v1 v2 vs, vn]-    | Nat n <- upcastNaturals vn =-       let vals = v1:v2:vs-           i    = fromInteger n-        in if i > 0 && i <= length vals-              then rewriteTo (FValue (vals !! (i-1)))-              else partialOp (tuple_index_ (fvalues args)) "index out of range"-stepTupleIndex args = sortErr (tuple_index_ (fvalues args)) "tuple-index must be applied to a (non-empty) tuple and a natural number"
− manual/Funcons/Core/Values/Composite/Collections/Vectors.hs 
@@ -1,63 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Values.Composite.Collections.Vectors where--import Funcons.Types-import Funcons.EDSL-import qualified Data.Vector as V--library = libFromList [-        ("vector-repeat", ValueOp stepVector_Repeat)-    ,   ("vector-length", ValueOp vector_length_op)-    ,   ("vector-index", ValueOp stepVector_Index)-    ,   ("vector-append", ValueOp vector_append_op)-    ,   ("vector", ValueOp stepVector)-    ,   ("list-to-vector", ValueOp list_to_vector_op)-    ,   ("vector-to-list", ValueOp stepVector_To_List)-    ]--stepVector_Repeat [m,v]-    | Nat n <- upcastNaturals m = rewriteTo $ FValue $ Vector $ V.replicate (fromInteger n) v-stepVector_Repeat v             = sortErr (applyFuncon "vector-repeat" (fvalues v)) "vector-repeat not applied to a nat and value"--stepVector_To_List [Vector v]   = rewriteTo $ listval $ V.toList v-stepVector_To_List v            = sortErr (applyFuncon "vector-to-list" (fvalues v)) "vector-to-list not applied to a vector"--vector_empty :: Rewrite Rewritten-vector_empty = rewritten (Vector V.empty)--vector_length_op [Vector v] = rewriteTo $ int_ (V.length v)-vector_length_op vs = sortErr (applyFuncon "vector-length" (fvalues vs))-                                "vector-length not applied to vector"--stepVector_Index :: [Values] -> Rewrite Rewritten-stepVector_Index [v,n] = vector_index_op v n- where-    vector_index_op :: Values -> Values -> Rewrite Rewritten-    vector_index_op (Vector v) vn | Nat n <- upcastNaturals vn =-        case v V.!? (fromInteger n) of-            Nothing -> partialOp (applyFuncon "vector-index" [FValue (Vector v), FValue vn]) "vector-index out of range"-            Just r  -> rewriteTo $ FValue $ r-    vector_index_op v vn = sortErr (applyFuncon "vector-index" [FValue v, FValue vn]) "vector-index not applied to a vector and a natural number"-stepVector_Index vs = sortErr (applyFuncon "vector-index" (fvalues vs)) "vector-index not applied to a vector and a natural number"--vector_append = applyFuncon "vector-append"-vector_append_op :: [Values] -> Rewrite Rewritten-vector_append_op vs-    | all isVec vs = rewriteTo $ FValue $ Vector $ foldr ((V.++) . toVec) V.empty vs- where toVec (Vector v) = v-       toVec _          = error "vector-append not applied to vectors"-       isVec (Vector v) = True-       isVec _          = False-vector_append_op vs = sortErr (vector_append (fvalues vs))-                                    "vector-append not applied to a sequence of vectors"--stepVector vs = rewriteTo $ FValue (Vector (V.fromList vs))--vector_repeat = applyFuncon "vector-repeat"--list_to_vector = applyFuncon "list-to-vector"-list_to_vector_op :: [Values] -> Rewrite Rewritten-list_to_vector_op [List l] = rewriteTo $ FValue $ Vector $ V.fromList l-list_to_vector_op vs = sortErr (list_to_vector (fvalues vs))-                            "list-to-vector not applied to a list"
+ manual/Funcons/Core/Values/Composite/DatatypesBuiltin.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE OverloadedStrings, LambdaCase #-}++module Funcons.Core.Values.Composite.DatatypesBuiltin where++import Funcons.EDSL+import Funcons.MSOS (evalStrictSequence, evalSequence, Strictness(..))+import Funcons.Operations (Values(..), Types(..), ComputationTypes(..))+import Data.Text (pack,unpack)++library = libFromList [+        ("datatype-value", NonStrictFuncon evalADT)+    ,   ("non-strict-datatype-value", NonStrictFuncon evalLazyADT)+    -- backwards compatibility+    ,   ("adt-construct", StrictFuncon adtConstruct)+    ,   ("adt-type-construct", StrictFuncon adtTypeConstruct)+    ,   ("adt-constructor", StrictFuncon adtConstructor)+    ,   ("adt-fields", StrictFuncon adtFields)+    ]++datatype_value_ = applyFuncon "datatype-value"+adt_val_ = datatype_value_++evalADT (f:fs) = evalStrictSequence (f:fs) cont adt_val_+  where+    cont [] = error "eval-adt assert"+    cont (v:vs) = case v of+      ADTVal "list" s | all isAscii s  +        -> rewritten $ ADTVal (pack (map (\(FValue (Ascii c)) -> c) s)) $ map FValue vs +      _ -> sortErr (adt_val_ (map FValue (v:vs))) ("first argument of datatype-value not a string") +evalADT [] = sortErr (adt_val_ [])+                    "algebraic-datatype not applied to a string and a sequence of fields"++lazy_adt_val_ = applyFuncon "non-strict-datatype-value"+evalLazyADT (f:fs) = evalSequence (Strict : replicate (length fs) NonStrict) +                          (f:fs) cont lazy_adt_val_+  where+    cont [] = error "lazy-eval-adt assert"+    cont (v:vs) = case v of+      FValue (ADTVal "list" s) | all isAscii s  +        -> rewritten $ ADTVal (pack (map (\(FValue (Ascii c)) -> c) s)) vs+      _ -> sortErr (lazy_adt_val_ (v:vs)) ("first argument of value constructor not a string") +evalLazyADT [] = sortErr (lazy_adt_val_ [])+                    "value constructor not applied to a string and a sequence of computations"++adt_construct_ = applyFuncon "adt-construct"+adtConstruct (v:vs) = case v of+      ADTVal "list" s | all isAscii s  +        -> rewritten $ ADTVal (pack (map (\(FValue (Ascii c)) -> c) s)) $ map FValue vs +      _ -> sortErr (adt_val_ (map FValue (v:vs))) ("first argument of adt-construct not a string") +adtConstruct [] = sortErr (adt_val_ [])+                    "adt-construct not applied to a string and a sequence of fields"++adt_type_construct_ = applyFuncon "adt-type-construct"+adtTypeConstruct (v:vs) +  | isString_ v = rewritten $ ComputationType $ Type $ ADT (pack (unString v)) fs+  | otherwise   = sortErr (adt_val_ (FValue v : fs)) ("first argument of adt-type-construct not a string") + where fs = map FValue vs+adtTypeConstruct [] = sortErr (adt_val_ [])+                    "adt-type-construct not applied to a string and a sequence of type arguments (values)"++adt_constructor_ = applyFuncon "adt-constructor"+adtConstructor [ADTVal cons _] = rewritten $ string__ (unpack cons)+adtConstructor vs = sortErr (adt_constructor_ (map FValue vs)) "argument of adt-constructor not an adt value"++adt_fields_ = applyFuncon "adt-fields"+adtFields [ADTVal _ fs] = rewritten $ ADTVal "list" fs+adtFields vs = sortErr (adt_fields_ (map FValue vs)) "argument of adt-fields not an adt value"
+ manual/Funcons/Core/Values/Composite/MapsBuiltin.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE OverloadedStrings #-}++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_)+  , ("is-map-empty", fromValOp is_map_empty_ VAL.is_map_empty_)+  , ("map-insert", fromValOp map_insert_ VAL.map_insert_)+  , ("map-lookup", fromValOp map_lookup_ VAL.map_lookup_)+  , ("lookup", fromValOp map_lookup_ VAL.map_lookup_)+  , ("map-domain", fromValOp map_domain_ VAL.domain_)+  , ("domain", fromValOp map_domain_ VAL.domain_)+  , ("dom", fromValOp map_domain_ VAL.domain_)+  , ("map-delete", fromValOp map_delete_ VAL.map_delete_)+  , ("is-in-domain", fromValOp is_in_domain_ VAL.is_in_domain_)+  , ("map-unite", fromValOp map_unite_ VAL.map_unite_)+  , ("map-override", fromValOp map_override_ VAL.map_override_)+  , ("maps", fromValOp maps_ VAL.maps_)+  , ("map", fromValOp map_ VAL.map_)+  , ("map-elements", fromSeqValOp map_elements_ VAL.map_elements_)+  , ("map-points", fromSeqValOp map_points_ VAL.map_points_)+  ]  ++map_ = applyFuncon "map"+maps_ = applyFuncon "maps"+map_empty_ = applyFuncon "map-empty"+is_map_empty_ = applyFuncon "is-map-empty"+is_in_domain_ = applyFuncon "is-in-domain"+map_insert_ = applyFuncon "map-insert"+map_delete_ = applyFuncon "map-delete"+-- |+-- Computes the union over a sequence of maps.+-- If the maps do not have disjoint domains a failure signal is raised.+map_unite_ = FApp "map-unite"+lookup_ = applyFuncon "lookup"+map_lookup_ = applyFuncon "lookup"+map_override_ = applyFuncon "map-override"+domain_ = applyFuncon "domain"+dom_ = applyFuncon "domain"+map_domain_ = applyFuncon "domain"+map_elements_ = applyFuncon "map-elements"+map_points_ = applyFuncon "map-points"
+ manual/Funcons/Core/Values/Composite/MultisetsBuiltin.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Values.Composite.MultisetsBuiltin where++import Funcons.EDSL+import Funcons.Operations hiding (Values)+import Funcons.Core.Values.Primitive.BoolBuiltin++import qualified Data.MultiSet as MS++library = libFromList [+        ("multiset-empty", NullaryFuncon (rewritten (Multiset MS.empty)))+    ,   ("sets-to-multiset", ValueOp stepSetsToMultiset)+    ,   ("multiset-to-set", ValueOp stepMultisetToSet)+--    ,   ("multiset-to-list", ValueOp stepMultisetToList)+--    ,   ("list-to-multiset", ValueOp list_to_multiset_op)+    ,   ("multiset-occurrences", ValueOp stepMultisetOccurrences)+    ,   ("multiset-insert", ValueOp stepMultisetInsert)+    ,   ("multiset-delete", ValueOp stepMultisetDelete)+    ,   ("is-submultiset", ValueOp stepIsSubMultiset)+    ]++is_sub_multiset = applyFuncon "is-sub-multiset"+stepIsSubMultiset [Multiset s1, Multiset s2] =+    rewriteTo $ FValue $ tobool (s1 `MS.isSubsetOf`s2)+stepIsSubMultiset vs = sortErr (is_sub_multiset (map FValue vs))+                            "is-sub-multiset not applied to two multisets"++multiset_delete = applyFuncon "multiset-delete"+stepMultisetDelete [Multiset ms, v, vn]+    | Nat n <- upcastNaturals vn = rewriteTo $ FValue $ Multiset (MS.deleteMany v (fromInteger n) ms)+stepMultisetDelete vs = sortErr (multiset_delete (map FValue vs))+    "multiset-delete not applied to a multiset, value and natural number"++multiset_insert = applyFuncon "multiset-insert"+stepMultisetInsert [v, vn, Multiset ms]+    | Nat n <- upcastNaturals vn = rewriteTo $ FValue $ Multiset (MS.insertMany v (fromInteger n) ms)+stepMultisetInsert vs = sortErr (multiset_insert (map FValue vs))+    "multiset-insert not applied to a value, natural number and multiset"++multiset_occurrences = applyFuncon "multiset-occurrences"+stepMultisetOccurrences [v, Multiset ms] = rewriteTo $ int_ (MS.occur v ms)+stepMultisetOccurrences vs = sortErr (multiset_occurrences (map FValue vs))+    "multiset-occurrences not applied to a value and a multiset"++multiset_to_set = applyFuncon "multiset-to-set"+stepMultisetToSet [Multiset ms] = rewriteTo $ FValue $ Set (MS.toSet ms)+stepMultisetToSet vs = sortErr (multiset_to_set (map FValue vs))+    "multiset-to-set not applied to a multiset"++{-+multiset_to_list = applyFuncon "multiset-to-list"+stepMultisetToList [Multiset ms] = rewriteTo $ FValue $ List $ map intPairToNatTuple (MS.toOccurList ms)+  where+    intPairToNatTuple :: (Values,Int) -> Values+    intPairToNatTuple (v,i) = NonEmptyTuple v (Nat $ toInteger i) []+stepMultisetToList vs = sortErr (multiset_to_list (map FValue vs))+    "multiset-to-list not applied to a multiset"++list_to_multiset_op vs@[List xs] = do ps <- mapM natTupleToIntPair xs+                                      rewriteTo $ FValue $ Multiset $ MS.fromOccurList ps+  where+    natTupleToIntPair :: Values -> Rewrite (Values,Int)+    natTupleToIntPair (NonEmptyTuple v m []) | Nat n <- upcastNaturals m = return (v,fromIntegral n)+    natTupleToIntPair _ = sortErr (applyFuncon "list-to-multiset" (fvalues vs))+                                  "list-to-multiset not applied to a list of tuples of values and naturals"+list_to_multiset_op vs = sortErr (applyFuncon "list-to-multiset" (fvalues vs))+                                 "list-to-multiset not applied to a list"+-}+++sets_to_multiset = applyFuncon "sets-to-multiset"+stepSetsToMultiset vs+    | all isSet_ vs = rewriteTo $ FValue $ Multiset (MS.unions (map toMS vs))+    | otherwise = sortErr (sets_to_multiset (map FValue vs))+        "sets-to-multiset not applied to sets"+    where   isSet_ (Set _)  = True+            isSet_ _        = False+            toMS (Set s)    = MS.fromSet s+            toMS _          = error "sets-to-multiset"
+ manual/Funcons/Core/Values/Composite/SetsBuiltin.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Values.Composite.SetsBuiltin where++import Funcons.EDSL hiding (set_)+import qualified Funcons.Operations as VAL +import Funcons.Core.Values.Primitive.BoolBuiltin++import qualified Data.Set as S++import Test.RandomStrings (randomString', randomASCII)+import System.IO.Unsafe (unsafePerformIO)++library = libFromList [+    ("set", fromValOp set_ VAL.set_)+  , ("set-empty", fromNullaryValOp set_empty_ VAL.set_empty_)+  , ("sets", fromValOp sets_ VAL.sets_)+  , ("is-in-set", fromValOp is_in_set_ VAL.is_in_set_)+  , ("set-elements", fromSeqValOp set_elements_ VAL.set_elements_)+  , ("is-subset", fromValOp is_subset_ VAL.is_subset_)  +  , ("set-insert", fromValOp set_insert_ VAL.set_insert_)+  , ("set-unite", fromValOp set_unite_ VAL.set_unite_)+  , ("set-intersect", fromValOp set_intersect_ VAL.set_intersect_)+  , ("set-difference", fromValOp set_difference_ VAL.set_difference_)+  , ("set-size", fromValOp set_size_ VAL.set_size_)+  , ("some-element", fromValOp some_element_ VAL.some_element_)+  , ("element-not-in", fromValOp element_not_in_ VAL.element_not_in_)+--  , ("is-set-empty", fromValOp is_set_empty_ VAL.is_set_empty_)+{-    ,   ("is-set-empty", ValueOp is_set_empty_op)+    ,   ("set-to-list", ValueOp stepSetToList)+    ,   ("list-to-set", ValueOp stepList_To_Set)-}+  ]++sets_ = applyFuncon "sets"+set_elements_ = applyFuncon "set-elements"+set_size_= applyFuncon "set-size"+set_intersect_= applyFuncon "set-intersect"+set_difference_ = applyFuncon "set-difference"+some_element_ = applyFuncon "some-element"+is_subset_ = applyFuncon "is-subset"+set_ = applyFuncon "set"+is_in_set_ = applyFuncon "is-in-set"+set_unite_ = applyFuncon "set-unite"+set_insert_ = applyFuncon "set-insert"+element_not_in_ = applyFuncon "element-not-in"+set_empty_ = applyFuncon "set-empty"+--is_set_empty_ = applyFuncon "is-set-empty"+--set_to_list_ = applyFuncon "set-to-list"+
manual/Funcons/Core/Values/Primitive/Atoms.hs view
@@ -2,12 +2,12 @@  module Funcons.Core.Values.Primitive.Atoms where -import Funcons.EDSL-import Funcons.Types+import Funcons.EDSL hiding (atom_)+import qualified Funcons.Operations as VAL  library = libFromList [-        ("atom", ValueOp stepAtom)+        ("atom", fromValOp atom_ VAL.atom_)     ] -stepAtom [String s] = rewriteTo $ FValue $ Atom s-stepAtom vs          = sortErr (applyFuncon "atom" (fvalues vs)) "atom not applied to a string"+atom_ = applyFuncon "atom"+
manual/Funcons/Core/Values/Primitive/BoolBuiltin.hs view
@@ -3,8 +3,9 @@ module Funcons.Core.Values.Primitive.BoolBuiltin where  import Funcons.EDSL+import Funcons.Operations hiding (Values) -tobool :: Bool -> Values -tobool True   = ADTVal "true" []-tobool False  = ADTVal "false" []+library = libFromList [] +bool_ :: Bool -> Funcons +bool_ = FValue . tobool
− manual/Funcons/Core/Values/Primitive/Characters.hs 
@@ -1,17 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Values.Primitive.Characters where--import Funcons.EDSL-import Funcons.Types--library = libFromList [-        ("ascii-characters", NullaryFuncon (rewriteTo $ type_ AsciiCharacters))-    ,   ("ascii-character", ValueOp stepAscii_Character) -    ]--ascii_character = applyFuncon "ascii-character"-stepAscii_Character [String [c]] = rewriteTo $ FValue $ Ascii $ fromEnum c-stepAscii_Character vs           = sortErr (ascii_character (fvalues vs))-     "ascii-character not applied to a string (of 1 ascii character long)"-
+ manual/Funcons/Core/Values/Primitive/CharactersBuiltin.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Values.Primitive.CharactersBuiltin where++import Funcons.EDSL+import qualified Funcons.Operations as VAL++library = libFromList [+        ("ascii-characters", fromValOp ascii_characters_ VAL.ascii_characters_)+    ,   ("ascii-characters", fromValOp ascii_character_ VAL.ascii_character_)+    ,   ("unicode", fromValOp unicode_ VAL.unicode_)+    ,   ("unicode-character-code", fromValOp unicode_character_code_ VAL.unicode_character_code_)+    ,   ("characters", fromNullaryValOp characters_ VAL.characters_)+    ,   ("chars", fromNullaryValOp characters_ VAL.characters_)+    ]++ascii_characters_ = applyFuncon "ascii-characters"+ascii_character_ = applyFuncon "ascii-character"+unicode_ = applyFuncon "unicode"+unicode_character_code_ = applyFuncon "unicode-character-code"+characters_ = applyFuncon "characters"+chars_ = applyFuncon "characters"
+ manual/Funcons/Core/Values/Primitive/FloatsBuiltin.hs view
@@ -0,0 +1,266 @@+{-# LANGUAGE OverloadedStrings #-}++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.Core.Values.Primitive.IntegersBuiltin++import Data.Fixed (mod')++library = libFromList [+        ("ieee-float-float-power", ValueOp stepIEEE_Float_Power)+    ,   ("ieee-float-add", ValueOp stepIEEE_Float_Add)+    ,   ("ieee-float-truncate", ValueOp stepIEEE_Float_Truncate)+    ,   ("ieee-float-multiply", ValueOp stepIEEE_Float_Multiply)+    ,   ("ieee-float-subtract", ValueOp stepIEEE_Float_Subtract)+    ,   ("ieee-float-negate", ValueOp stepIEEE_Float_Negate)+    ,   ("ieee-float-divide", ValueOp stepIEEE_Float_Divide)+--    ,   ("signed-bits-maximum", ValueOp stepSigned_Bits_Maximum)+--    ,   ("signed-bits-minimum", ValueOp stepSigned_Bits_Minimum)+    ,   ("ieee-float-acos", ValueOp stepIEEE_Float_Acos)+    ,   ("ieee-float-asin", ValueOp stepIEEE_Float_Asin)+    ,   ("ieee-float-atan", ValueOp stepIEEE_Float_Atan)+    ,   ("ieee-float-atan2", ValueOp stepIEEE_Float_Atan2)+    ,   ("ieee-float-cos", ValueOp stepIEEE_Float_Cos)+    ,   ("ieee-float-cosh", ValueOp stepIEEE_Float_Cosh)+    ,   ("ieee-float-exp", ValueOp stepIEEE_Float_Exp)+    ,   ("ieee-float-log", ValueOp stepIEEE_Float_Log)+    ,   ("ieee-float-log10", ValueOp stepIEEE_Float_Log10)+    ,   ("ieee-float-sin", ValueOp stepIEEE_Float_Sin)+    ,   ("ieee-float-sinh", ValueOp stepIEEE_Float_Sinh)+    ,   ("ieee-float-sqrt", ValueOp stepIEEE_Float_Sqrt)+    ,   ("ieee-float-tan", ValueOp stepIEEE_Float_Tan)+    ,   ("ieee-float-tanh", ValueOp stepIEEE_Float_Tanh)+    ,   ("ieee-float-ceiling", ValueOp stepIEEE_Float_Ceiling)+    ,   ("ieee-float-floor", ValueOp stepIEEE_Float_Floor)+    ,   ("ieee-float-absolute-value", ValueOp stepIEEE_Float_Absolute_Value)+    ,   ("ieee-float-remainder", ValueOp stepIEEE_Float_Remainder)+    ,   ("ieee-float-is-less", ValueOp stepIEEE_Float_Is_Less)+    ,   ("ieee-float-is-less-or-equal", ValueOp stepIEEE_Float_Is_Less_Or_Equal)+    ,   ("ieee-float-is-greater-or-equal", ValueOp stepIEEE_Float_Is_Greater_Or_Equal)+    ,   ("ieee-float-is-greater", ValueOp stepIEEE_Float_Is_Greater) +    ]++ieee_float_truncate = applyFuncon "ieee-float-truncate"+stepIEEE_Float_Truncate [IEEE_Float_64 f, ADTVal "binary64" _] = rewriteTo $ int_ (truncate f)+stepIEEE_Float_Truncate vn = sortErr (ieee_float_truncate (fvalues vn)) "ieee-float-truncate not applied to a float of the right format"+stepIEEE_Float_Add vs       = ieee_float_add_op vs+stepIEEE_Float_Multiply vs  = ieee_float_multiply_op vs+stepIEEE_Float_Subtract [f,f1,f2] = ieee_float_subtract_op f f1 f2+stepIEEE_Float_Subtract vn = sortErr (ieee_float_subtract (fvalues vn)) "sort check"+stepIEEE_Float_Negate [f,f1] = ieee_float_negate_op f f1+stepIEEE_Float_Negate vn = sortErr (ieee_float_negate (fvalues vn)) "sort check"+stepIEEE_Float_Divide [f,f1,f2] = ieee_float_divide_op f f1 f2+stepIEEE_Float_Divide vn = sortErr (ieee_float_divide (fvalues vn)) "sort check"+stepIEEE_Float_Power [f,f1,f2] = ieee_float_power_op f f1 f2+stepIEEE_Float_Power vn = sortErr (ieee_float_float_power (fvalues vn)) "sort check"++signed_bits_maximum = applyFuncon "signed-bits-maximum"+stepSigned_Bits_Maximum [vn] | Nat n <- upcastNaturals vn+        = rewriteTo $ integer_subtract_ [integer_power_ [int_ 2, integer_subtract_ [int_ $ fromInteger n, int_ 1]],int_ 1]+stepSigned_Bits_Maximum vs = sortErr (signed_bits_maximum (fvalues vs)) "sort check"++signed_bits_minimum = applyFuncon "signed-bits-minimum"+stepSigned_Bits_Minimum [vn] | Nat n <- upcastNaturals vn+        = rewriteTo $ applyFuncon "integer-negate" [signed_bits_maximum [FValue vn]]+stepSigned_Bits_Minimum vs = sortErr (signed_bits_maximum (fvalues vs)) "sort check"++    -- TODO binary64 assumption (perhaps use config files)+ieee_float_acos = applyFuncon "ieee-float-acos"+stepIEEE_Float_Acos [f,vx] = let f1 = doubleFromIEEEFormat f vx+                                     in rewriteTo $ FValue $ IEEE_Float_64 (acos f1)+stepIEEE_Float_Acos vn = sortErr (ieee_float_acos (fvalues vn)) "sort check"++ieee_float_asin = applyFuncon "ieee-float-asin"+stepIEEE_Float_Asin [f,vx] = let f1 = doubleFromIEEEFormat f vx+                                     in rewriteTo $ FValue $ IEEE_Float_64 (asin f1)+stepIEEE_Float_Asin vn = sortErr (ieee_float_asin (fvalues vn)) "sort check"++ieee_float_atan = applyFuncon "ieee-float-atan"+stepIEEE_Float_Atan [f,vx] = let f1 = doubleFromIEEEFormat f vx+                                     in rewriteTo $ FValue $ IEEE_Float_64 (atan f1)+stepIEEE_Float_Atan vn = sortErr (ieee_float_atan (fvalues vn)) "sort check"++ieee_float_atan2 = applyFuncon "ieee-float-atan2"+stepIEEE_Float_Atan2 [f,vx,vy] = let f1 = doubleFromIEEEFormat f vx+                                     f2 = doubleFromIEEEFormat f vy+                                 in rewriteTo $ FValue $ IEEE_Float_64 (atan2 f1 f2)+stepIEEE_Float_Atan2 vn = sortErr (ieee_float_atan2 (fvalues vn)) "sort check"++ieee_float_cos = applyFuncon "ieee-float-cos"+stepIEEE_Float_Cos [f,vx] = let f1 = doubleFromIEEEFormat f vx+                                     in rewriteTo $ FValue $ IEEE_Float_64 (cos f1)+stepIEEE_Float_Cos vn = sortErr (ieee_float_cos (fvalues vn)) "sort check"++ieee_float_cosh = applyFuncon "ieee-float-cosh"+stepIEEE_Float_Cosh [f,vx] = let f1 = doubleFromIEEEFormat f vx+                                     in rewriteTo $ FValue $ IEEE_Float_64 (cosh f1)+stepIEEE_Float_Cosh vn = sortErr (ieee_float_cosh (fvalues vn)) "sort check"++ieee_float_exp = applyFuncon "ieee-float-exp"+stepIEEE_Float_Exp [f,vx] = let f1 = doubleFromIEEEFormat f vx+                                     in rewriteTo $ FValue $ IEEE_Float_64 (exp f1)+stepIEEE_Float_Exp vn = sortErr (ieee_float_exp (fvalues vn)) "sort check"++ieee_float_log = applyFuncon "ieee-float-log"+stepIEEE_Float_Log [f,vx] = let f1 = doubleFromIEEEFormat f vx+                                     in rewriteTo $ FValue $ IEEE_Float_64 (log f1)+stepIEEE_Float_Log vn = sortErr (ieee_float_log (fvalues vn)) "sort check"++ieee_float_log10 = applyFuncon "ieee-float-log10"+stepIEEE_Float_Log10 [f,vx] = let f1 = doubleFromIEEEFormat f vx+                                     in rewriteTo $ FValue $ IEEE_Float_64 (logBase 10 f1)+stepIEEE_Float_Log10 vn = sortErr (ieee_float_log10 (fvalues vn)) "sort check"++ieee_float_sin = applyFuncon "ieee-float-sin"+stepIEEE_Float_Sin [f,vx] = let f1 = doubleFromIEEEFormat f vx+                                     in rewriteTo $ FValue $ IEEE_Float_64 (sin f1)+stepIEEE_Float_Sin vn = sortErr (ieee_float_sin (fvalues vn)) "sort check"++ieee_float_sinh = applyFuncon "ieee-float-sinh"+stepIEEE_Float_Sinh [f,vx] = let f1 = doubleFromIEEEFormat f vx+                                     in rewriteTo $ FValue $ IEEE_Float_64 (sinh f1)+stepIEEE_Float_Sinh vn = sortErr (ieee_float_sinh (fvalues vn)) "sort check"++ieee_float_sqrt = applyFuncon "ieee-float-sqrt"+stepIEEE_Float_Sqrt [f,vx] = let f1 = doubleFromIEEEFormat f vx+                                     in rewriteTo $ FValue $ IEEE_Float_64 (sqrt f1)+stepIEEE_Float_Sqrt vn = sortErr (ieee_float_sqrt (fvalues vn)) "sort check"++ieee_float_tan = applyFuncon "ieee-float-tan"+stepIEEE_Float_Tan [f,vx] = let f1 = doubleFromIEEEFormat f vx+                                     in rewriteTo $ FValue $ IEEE_Float_64 (tan f1)+stepIEEE_Float_Tan vn = sortErr (ieee_float_tan (fvalues vn)) "sort check"++ieee_float_tanh = applyFuncon "ieee-float-tanh"+stepIEEE_Float_Tanh [f,vx] = let f1 = doubleFromIEEEFormat f vx+                                     in rewriteTo $ FValue $ IEEE_Float_64 (tanh f1)+stepIEEE_Float_Tanh vn = sortErr (ieee_float_tanh (fvalues vn)) "sort check"++ieee_float_ceiling = applyFuncon "ieee-float-ceiling"+stepIEEE_Float_Ceiling [f,vx] = let f1 = doubleFromIEEEFormat f vx+                                     in rewriteTo $ int_ (ceiling f1)+stepIEEE_Float_Ceiling vn = sortErr (ieee_float_ceiling (fvalues vn)) "sort check"++ieee_float_floor = applyFuncon "ieee-float-floor"+stepIEEE_Float_Floor [f,vx] = let f1 = doubleFromIEEEFormat f vx+                                     in rewriteTo $ int_ (floor f1)+stepIEEE_Float_Floor vn = sortErr (ieee_float_floor (fvalues vn)) "sort check"++ieee_float_absolute_value = applyFuncon "ieee-float-absolute-value"+stepIEEE_Float_Absolute_Value [f,vx] = let f1 = doubleFromIEEEFormat f vx+                                     in rewriteTo $ FValue $ IEEE_Float_64 (Prelude.abs f1)+stepIEEE_Float_Absolute_Value vn = sortErr (ieee_float_absolute_value (fvalues vn)) "sort check"++stepIEEE_Float_Remainder [f,f1,f2] = ieee_float_remainder_op f f1 f2+stepIEEE_Float_Remainder vn = sortErr (ieee_float_remainder (fvalues vn)) "sort check"++stepIEEE_Float_Is_Less [f,f1,f2] = ieee_float_is_less_op f f1 f2+stepIEEE_Float_Is_Less vn = sortErr (ieee_float_is_less (fvalues vn)) "sort check"+stepIEEE_Float_Is_Greater [f,f1,f2] = ieee_float_is_greater_op f f1 f2+stepIEEE_Float_Is_Greater vn = sortErr (ieee_float_is_greater (fvalues vn)) "sort check"+stepIEEE_Float_Is_Less_Or_Equal [f,f1,f2] = ieee_float_is_less_or_equal_op f f1 f2+stepIEEE_Float_Is_Less_Or_Equal vn = sortErr (ieee_float_is_less_or_equal (fvalues vn)) "sort check"+stepIEEE_Float_Is_Greater_Or_Equal [f,f1,f2] = ieee_float_is_greater_or_equal_op f f1 f2+stepIEEE_Float_Is_Greater_Or_Equal vn = sortErr (ieee_float_is_greater_or_equal (fvalues vn)) "sort check"+++ieee_float_op :: String -> ([Funcons] -> Funcons)+               -> (Double -> Double -> Double) +                -> Double -> Funcons.EDSL.Values -> [Funcons.EDSL.Values] -> Rewrite Rewritten+ieee_float_op str cons f b format vs+    | all (isIEEEFormat format) vs = rewriteTo $ FValue $ IEEE_Float_64+        $ foldr f b $ map (doubleFromIEEEFormat format) vs+    | otherwise = sortErr (cons (map FValue vs)) err+    where   err     = str ++ " not applied to ieee_floats"++ieee_float_add = applyFuncon "ieee-float-add"+ieee_float_add_op (format:vs) = ieee_float_op "ieee_float-add" ieee_float_add (+) 0 format vs+ieee_float_add_op [] = sortErr (ieee_float_add [FValue (ADTVal "list" [])]) "ieee-float-add not applied to a format and a list of floats"++ieee_float_multiply_ = ieee_float_multiply +ieee_float_multiply = applyFuncon "ieee-float-multiply"+ieee_float_multiply_op (format:vs) = ieee_float_op "ieee_float-multiply" ieee_float_multiply (*) 1 format vs+ieee_float_multiply_op [] = sortErr (ieee_float_multiply [FValue (ADTVal "list" [])]) "ieee-float-multiply not applied to a format and a list of floats"++ieee_float_divide = applyFuncon "ieee-float-divide"+ieee_float_divide_op format vx vy+    | isIEEEFormat format vx && isIEEEFormat format vy =+        let f1 = doubleFromIEEEFormat format vx+            f2 = doubleFromIEEEFormat format vy+        in rewriteTo $ FValue $ IEEE_Float_64 $ (f1 / f2)+ieee_float_divide_op ft vx vy = sortErr (ieee_float_divide [FValue ft,FValue vx, FValue vy])+                         "ieee-float-divide not applied to a format and ieee-floats"++ieee_float_remainder = applyFuncon "ieee-float-remainder"+ieee_float_remainder_op format vx vy+    | isIEEEFormat format vx =+        let f1 = doubleFromIEEEFormat format vx+            f2 = doubleFromIEEEFormat format vy+        in rewriteTo $ FValue $ IEEE_Float_64 $ (f1 `mod'` f2)+ieee_float_remainder_op ft vx vy = sortErr (ieee_float_remainder [FValue ft,FValue vx, FValue vy])+                         "ieee-float-remainder not applied to a format and ieee-floats"++ieee_float_negate = applyFuncon "ieee-float-negate"+ieee_float_negate_op format vx+    | isIEEEFormat format vx = let f1 = doubleFromIEEEFormat format vx+                               in rewriteTo $ FValue $ IEEE_Float_64 (-f1)+    | otherwise = sortErr (ieee_float_negate [FValue format,FValue vx]) "ieee-float-negate not applied to ieee-float"++ieee_float_subtract = applyFuncon "ieee-float-subtract"+ieee_float_subtract_op format vx vy+    | isIEEEFormat format vx && isIEEEFormat format vy =+        let f1 = doubleFromIEEEFormat format vx+            f2 = doubleFromIEEEFormat format vy+        in rewriteTo $ FValue $ IEEE_Float_64 $ (f1 - f2)+ieee_float_subtract_op ft vx vy = sortErr (ieee_float_subtract [FValue ft, FValue vx, FValue vy])+                         "ieee-float-subtract not applied to a format and ieee-floats"++ieee_float_float_power = applyFuncon "ieee-float-float-power"+ieee_float_power_op format vx vy+    | isIEEEFormat format vx && isIEEEFormat format vy =+        let f1 = doubleFromIEEEFormat format vx+            f2 = doubleFromIEEEFormat format vy+        in rewriteTo $ FValue $ IEEE_Float_64 $ (f1 ** f2)+ieee_float_power_op ft vx vy = sortErr (ieee_float_float_power [FValue ft, FValue vx, FValue vy])+                         "ieee-float-power not applied to a format and ieee-floats"++ieee_float_is_less = applyFuncon "ieee-float-is-less"+ieee_float_is_less_op format vx vy+    | isIEEEFormat format vx && isIEEEFormat format vy =+        let f1 = doubleFromIEEEFormat format vx+            f2 = doubleFromIEEEFormat format vy+        in rewriteTo $ FValue $ tobool (f1 < f2)+ieee_float_is_less_op ft vx vy = sortErr (ieee_float_is_less [FValue ft, FValue vx, FValue vy])+                         "ieee-float-is-less not applied to a format and ieee-floats"++ieee_float_is_greater = applyFuncon "ieee-float-is-greater"+ieee_float_is_greater_op format vx vy+    | isIEEEFormat format vx && isIEEEFormat format vy =+        let f1 = doubleFromIEEEFormat format vx+            f2 = doubleFromIEEEFormat format vy+        in rewriteTo $ FValue $ tobool (f1 > f2)+ieee_float_is_greater_op ft vx vy = sortErr (ieee_float_is_greater [FValue ft, FValue vx, FValue vy])+                         "ieee-float-is-greater not applied to a format and ieee-floats"++ieee_float_is_less_or_equal = applyFuncon "ieee-float-is-less-or-equal"+ieee_float_is_less_or_equal_op format vx vy+    | isIEEEFormat format vx && isIEEEFormat format vy =+        let f1 = doubleFromIEEEFormat format vx+            f2 = doubleFromIEEEFormat format vy+        in rewriteTo $ FValue $ tobool (f1 <= f2)+ieee_float_is_less_or_equal_op ft vx vy = sortErr (ieee_float_is_less_or_equal [FValue ft,FValue vx, FValue vy])+                         "ieee-float-is-less-or-equal not applied to a format and ieee-floats"++ieee_float_is_greater_or_equal = applyFuncon "ieee-float-is-greater-or-equal"+ieee_float_is_greater_or_equal_op format vx vy+    | isIEEEFormat format vx && isIEEEFormat format vy =+        let f1 = doubleFromIEEEFormat format vx+            f2 = doubleFromIEEEFormat format vy+        in rewriteTo $ FValue $ tobool (f1 >= f2)+ieee_float_is_greater_or_equal_op ft vx vy = sortErr (ieee_float_is_greater_or_equal [FValue ft,FValue vx, FValue vy])+                         "ieee-float-is-greater-or-equal not applied to a format and ieee-floats"++
+ manual/Funcons/Core/Values/Primitive/IntegersBuiltin.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE OverloadedStrings #-}++module Funcons.Core.Values.Primitive.IntegersBuiltin where++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_)+  , ("int-mul", fromValOp integer_multiply_ VAL.integer_multiply_)+  , ("integer-multiply", fromValOp integer_multiply_ VAL.integer_multiply_)+  , ("integer-divide", fromValOp integer_divide_ VAL.integer_divide_)+  , ("int-div", fromValOp integer_divide_ VAL.integer_divide_)+  , ("integer-subtract", fromValOp integer_subtract_ VAL.integer_subtract_)+  , ("integer-sub", fromValOp integer_subtract_ VAL.integer_subtract_)+  , ("integer-power", fromValOp integer_power_ VAL.integer_power_)+  , ("int-pow", fromValOp integer_power_ VAL.integer_power_)+  , ("integer-list", fromValOp integer_list_ VAL.integer_list_)+  , ("integer-modulo", fromValOp integer_modulo_ VAL.integer_modulo_)+  , ("integer-absolute-value", fromValOp integer_absolute_value_ VAL.integer_absolute_value_)+  , ("integer-abs", fromValOp integer_absolute_value_ VAL.integer_absolute_value_)+  , ("decimal-natural", fromValOp decimal_natural_ VAL.decimal_natural_)+  , ("natural-predecessor", fromValOp natural_predecessor_ VAL.natural_predecessor_)+  , ("nat-pred", fromValOp natural_predecessor_ VAL.natural_predecessor_)+  , ("natural-successor", fromValOp natural_successor_ VAL.natural_successor_)+  , ("nat-succ", fromValOp natural_successor_ VAL.natural_successor_)+  , ("integer-is-less", fromValOp is_less_ VAL.is_less_)+  , ("is-less", fromValOp is_less_ VAL.is_less_)+  , ("integer-is-greater", fromValOp is_greater_ VAL.is_greater_)+  , ("is-greater", fromValOp is_greater_ VAL.is_greater_)+  , ("integer-is-greater-or-equal", fromValOp is_greater_or_equal_ VAL.is_greater_or_equal_)+  , ("is-greater-or-equal", fromValOp is_greater_or_equal_ VAL.is_greater_or_equal_)+  , ("integer-is-less-or-equal", fromValOp is_less_or_equal_ VAL.is_less_or_equal_)+  , ("is-less-or-equal", fromValOp is_less_or_equal_ VAL.is_less_or_equal_)+  , ("integers", fromNullaryValOp integers_ VAL.integers_)+  , ("ints", fromNullaryValOp integers_ VAL.integers_)+  ]++ints_ = integers_+integers_ = applyFuncon "integers"+natural_predecessor_, nat_pred_ :: [Funcons] -> Funcons+natural_predecessor_ = applyFuncon "natural-predecessor"+nat_pred_ = applyFuncon "nat-pred"+natural_successor_, nat_succ_ :: [Funcons] -> Funcons+natural_successor_ = applyFuncon "natural-successor"+nat_succ_ = applyFuncon "nat-succ"+int_add_ = FApp "integer-add"+integer_add_ = FApp "integer-add"+integer_multiply_ = FApp "integer-multiply" +integer_divide_ = FApp "integer-divide"+integer_subtract_ = applyFuncon "integer-subtract"+integer_power_ = applyFuncon "integer-power"+integer_power_op vx = sortErr (applyFuncon "integer-power" (fvalues vx))+                            "integer-power not applied to two integers"+integer_list_ = applyFuncon "integer-list"+integer_modulo_ = applyFuncon "integer-modulo"+integer_mod_ = applyFuncon "integer-modulo"+integer_absolute_value_ = applyFuncon "integer-absolute-value"+decimal_natural_ = FApp "decimal-natural"+is_less_ = applyFuncon "is-less" +integer_is_less_ = applyFuncon "is-less" +is_less_or_equal_ = FApp "is-less-or-equal"+integer_is_less_or_equal_ = FApp "is-less-or-equal"+is_greater_ = FApp "is-greater"+integer_is_greater_ = FApp "is-greater"+is_greater_or_equal_ = FApp "is-greater-or-equal"+integer_is_greater_or_equal_ = FApp "is-greater-or-equal"
− manual/Funcons/Core/Values/Primitive/Numbers/IeeeFloatsBuiltin.hs 
@@ -1,275 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Values.Primitive.Numbers.IeeeFloatsBuiltin where--import Funcons.EDSL-import Funcons.Types-import Funcons.Core.Values.Primitive.BoolBuiltin-import Funcons.Core.Values.Primitive.Numbers.Integers--import Data.Fixed (mod')--library = libFromList [-        ("ieee-float-float-power", ValueOp stepIEEE_Float_Power)-    ,   ("ieee-float-add", ValueOp stepIEEE_Float_Add)-    ,   ("ieee-float-truncate", ValueOp stepIEEE_Float_Truncate)-    ,   ("ieee-float-multiply", ValueOp stepIEEE_Float_Multiply)-    ,   ("ieee-float-subtract", ValueOp stepIEEE_Float_Subtract)-    ,   ("ieee-float-negate", ValueOp stepIEEE_Float_Negate)-    ,   ("ieee-float-divide", ValueOp stepIEEE_Float_Divide)---    ,   ("signed-bits-maximum", ValueOp stepSigned_Bits_Maximum)---    ,   ("signed-bits-minimum", ValueOp stepSigned_Bits_Minimum)-    ,   ("ieee-float-acos", ValueOp stepIEEE_Float_Acos)-    ,   ("ieee-float-asin", ValueOp stepIEEE_Float_Asin)-    ,   ("ieee-float-atan", ValueOp stepIEEE_Float_Atan)-    ,   ("ieee-float-atan2", ValueOp stepIEEE_Float_Atan2)-    ,   ("ieee-float-cos", ValueOp stepIEEE_Float_Cos)-    ,   ("ieee-float-cosh", ValueOp stepIEEE_Float_Cosh)-    ,   ("ieee-float-exp", ValueOp stepIEEE_Float_Exp)-    ,   ("ieee-float-log", ValueOp stepIEEE_Float_Log)-    ,   ("ieee-float-log10", ValueOp stepIEEE_Float_Log10)-    ,   ("ieee-float-sin", ValueOp stepIEEE_Float_Sin)-    ,   ("ieee-float-sinh", ValueOp stepIEEE_Float_Sinh)-    ,   ("ieee-float-sqrt", ValueOp stepIEEE_Float_Sqrt)-    ,   ("ieee-float-tan", ValueOp stepIEEE_Float_Tan)-    ,   ("ieee-float-tanh", ValueOp stepIEEE_Float_Tanh)-    ,   ("ieee-float-ceiling", ValueOp stepIEEE_Float_Ceiling)-    ,   ("ieee-float-floor", ValueOp stepIEEE_Float_Floor)-    ,   ("ieee-float-absolute-value", ValueOp stepIEEE_Float_Absolute_Value)-    ,   ("ieee-float-remainder", ValueOp stepIEEE_Float_Remainder)-    ,   ("ieee-float-is-less", ValueOp stepIEEE_Float_Is_Less)-    ,   ("ieee-float-is-less-or-equal", ValueOp stepIEEE_Float_Is_Less_Or_Equal)-    ,   ("ieee-float-is-greater-or-equal", ValueOp stepIEEE_Float_Is_Greater_Or_Equal)-    ,   ("ieee-float-is-greater", ValueOp stepIEEE_Float_Is_Greater) -    ]--ieee_float_truncate = applyFuncon "ieee-float-truncate"-stepIEEE_Float_Truncate [IEEE_Float_64 f, ADTVal "binary64" _] = rewriteTo $ int_ (truncate f)-stepIEEE_Float_Truncate vn = sortErr (ieee_float_truncate (fvalues vn)) "ieee-float-truncate not applied to a float of the right format"-stepIEEE_Float_Add vs       = ieee_float_add_op vs-stepIEEE_Float_Multiply vs  = ieee_float_multiply_op vs-stepIEEE_Float_Subtract [f,f1,f2] = ieee_float_subtract_op f f1 f2-stepIEEE_Float_Subtract vn = sortErr (ieee_float_subtract (fvalues vn)) "sort check"-stepIEEE_Float_Negate [f,f1] = ieee_float_negate_op f f1-stepIEEE_Float_Negate vn = sortErr (ieee_float_negate (fvalues vn)) "sort check"-stepIEEE_Float_Divide [f,f1,f2] = ieee_float_divide_op f f1 f2-stepIEEE_Float_Divide vn = sortErr (ieee_float_divide (fvalues vn)) "sort check"-stepIEEE_Float_Power [f,f1,f2] = ieee_float_power_op f f1 f2-stepIEEE_Float_Power vn = sortErr (ieee_float_float_power (fvalues vn)) "sort check"--signed_bits_maximum = applyFuncon "signed-bits-maximum"-stepSigned_Bits_Maximum [vn] | Nat n <- upcastNaturals vn-        = rewriteTo $ integer_subtract[integer_power[int_ 2, integer_subtract [int_ $ fromInteger n, int_ 1]],int_ 1]-stepSigned_Bits_Maximum vs = sortErr (signed_bits_maximum (fvalues vs)) "sort check"--signed_bits_minimum = applyFuncon "signed-bits-minimum"-stepSigned_Bits_Minimum [vn] | Nat n <- upcastNaturals vn-        = rewriteTo $ applyFuncon "integer-negate" [signed_bits_maximum [FValue vn]]-stepSigned_Bits_Minimum vs = sortErr (signed_bits_maximum (fvalues vs)) "sort check"--    -- TODO binary64 assumption (perhaps use config files)-ieee_float_acos = applyFuncon "ieee-float-acos"-stepIEEE_Float_Acos [f,vx] = let f1 = doubleFromIEEEFormat f vx-                                     in rewriteTo $ FValue $ IEEE_Float_64 (acos f1)-stepIEEE_Float_Acos vn = sortErr (ieee_float_acos (fvalues vn)) "sort check"--ieee_float_asin = applyFuncon "ieee-float-asin"-stepIEEE_Float_Asin [f,vx] = let f1 = doubleFromIEEEFormat f vx-                                     in rewriteTo $ FValue $ IEEE_Float_64 (asin f1)-stepIEEE_Float_Asin vn = sortErr (ieee_float_asin (fvalues vn)) "sort check"--ieee_float_atan = applyFuncon "ieee-float-atan"-stepIEEE_Float_Atan [f,vx] = let f1 = doubleFromIEEEFormat f vx-                                     in rewriteTo $ FValue $ IEEE_Float_64 (atan f1)-stepIEEE_Float_Atan vn = sortErr (ieee_float_atan (fvalues vn)) "sort check"--ieee_float_atan2 = applyFuncon "ieee-float-atan2"-stepIEEE_Float_Atan2 [f,vx,vy] = let f1 = doubleFromIEEEFormat f vx-                                     f2 = doubleFromIEEEFormat f vy-                                 in rewriteTo $ FValue $ IEEE_Float_64 (atan2 f1 f2)-stepIEEE_Float_Atan2 vn = sortErr (ieee_float_atan2 (fvalues vn)) "sort check"--ieee_float_cos = applyFuncon "ieee-float-cos"-stepIEEE_Float_Cos [f,vx] = let f1 = doubleFromIEEEFormat f vx-                                     in rewriteTo $ FValue $ IEEE_Float_64 (cos f1)-stepIEEE_Float_Cos vn = sortErr (ieee_float_cos (fvalues vn)) "sort check"--ieee_float_cosh = applyFuncon "ieee-float-cosh"-stepIEEE_Float_Cosh [f,vx] = let f1 = doubleFromIEEEFormat f vx-                                     in rewriteTo $ FValue $ IEEE_Float_64 (cosh f1)-stepIEEE_Float_Cosh vn = sortErr (ieee_float_cosh (fvalues vn)) "sort check"--ieee_float_exp = applyFuncon "ieee-float-exp"-stepIEEE_Float_Exp [f,vx] = let f1 = doubleFromIEEEFormat f vx-                                     in rewriteTo $ FValue $ IEEE_Float_64 (exp f1)-stepIEEE_Float_Exp vn = sortErr (ieee_float_exp (fvalues vn)) "sort check"--ieee_float_log = applyFuncon "ieee-float-log"-stepIEEE_Float_Log [f,vx] = let f1 = doubleFromIEEEFormat f vx-                                     in rewriteTo $ FValue $ IEEE_Float_64 (log f1)-stepIEEE_Float_Log vn = sortErr (ieee_float_log (fvalues vn)) "sort check"--ieee_float_log10 = applyFuncon "ieee-float-log10"-stepIEEE_Float_Log10 [f,vx] = let f1 = doubleFromIEEEFormat f vx-                                     in rewriteTo $ FValue $ IEEE_Float_64 (logBase 10 f1)-stepIEEE_Float_Log10 vn = sortErr (ieee_float_log10 (fvalues vn)) "sort check"--ieee_float_sin = applyFuncon "ieee-float-sin"-stepIEEE_Float_Sin [f,vx] = let f1 = doubleFromIEEEFormat f vx-                                     in rewriteTo $ FValue $ IEEE_Float_64 (sin f1)-stepIEEE_Float_Sin vn = sortErr (ieee_float_sin (fvalues vn)) "sort check"--ieee_float_sinh = applyFuncon "ieee-float-sinh"-stepIEEE_Float_Sinh [f,vx] = let f1 = doubleFromIEEEFormat f vx-                                     in rewriteTo $ FValue $ IEEE_Float_64 (sinh f1)-stepIEEE_Float_Sinh vn = sortErr (ieee_float_sinh (fvalues vn)) "sort check"--ieee_float_sqrt = applyFuncon "ieee-float-sqrt"-stepIEEE_Float_Sqrt [f,vx] = let f1 = doubleFromIEEEFormat f vx-                                     in rewriteTo $ FValue $ IEEE_Float_64 (sqrt f1)-stepIEEE_Float_Sqrt vn = sortErr (ieee_float_sqrt (fvalues vn)) "sort check"--ieee_float_tan = applyFuncon "ieee-float-tan"-stepIEEE_Float_Tan [f,vx] = let f1 = doubleFromIEEEFormat f vx-                                     in rewriteTo $ FValue $ IEEE_Float_64 (tan f1)-stepIEEE_Float_Tan vn = sortErr (ieee_float_tan (fvalues vn)) "sort check"--ieee_float_tanh = applyFuncon "ieee-float-tanh"-stepIEEE_Float_Tanh [f,vx] = let f1 = doubleFromIEEEFormat f vx-                                     in rewriteTo $ FValue $ IEEE_Float_64 (tanh f1)-stepIEEE_Float_Tanh vn = sortErr (ieee_float_tanh (fvalues vn)) "sort check"--ieee_float_ceiling = applyFuncon "ieee-float-ceiling"-stepIEEE_Float_Ceiling [f,vx] = let f1 = doubleFromIEEEFormat f vx-                                     in rewriteTo $ int_ (ceiling f1)-stepIEEE_Float_Ceiling vn = sortErr (ieee_float_ceiling (fvalues vn)) "sort check"--ieee_float_floor = applyFuncon "ieee-float-floor"-stepIEEE_Float_Floor [f,vx] = let f1 = doubleFromIEEEFormat f vx-                                     in rewriteTo $ int_ (floor f1)-stepIEEE_Float_Floor vn = sortErr (ieee_float_floor (fvalues vn)) "sort check"--ieee_float_absolute_value = applyFuncon "ieee-float-absolute-value"-stepIEEE_Float_Absolute_Value [f,vx] = let f1 = doubleFromIEEEFormat f vx-                                     in rewriteTo $ FValue $ IEEE_Float_64 (Prelude.abs f1)-stepIEEE_Float_Absolute_Value vn = sortErr (ieee_float_absolute_value (fvalues vn)) "sort check"--stepIEEE_Float_Remainder [f,f1,f2] = ieee_float_remainder_op f f1 f2-stepIEEE_Float_Remainder vn = sortErr (ieee_float_remainder (fvalues vn)) "sort check"--stepIEEE_Float_Is_Less [f,f1,f2] = ieee_float_is_less_op f f1 f2-stepIEEE_Float_Is_Less vn = sortErr (ieee_float_is_less (fvalues vn)) "sort check"-stepIEEE_Float_Is_Greater [f,f1,f2] = ieee_float_is_greater_op f f1 f2-stepIEEE_Float_Is_Greater vn = sortErr (ieee_float_is_greater (fvalues vn)) "sort check"-stepIEEE_Float_Is_Less_Or_Equal [f,f1,f2] = ieee_float_is_less_or_equal_op f f1 f2-stepIEEE_Float_Is_Less_Or_Equal vn = sortErr (ieee_float_is_less_or_equal (fvalues vn)) "sort check"-stepIEEE_Float_Is_Greater_Or_Equal [f,f1,f2] = ieee_float_is_greater_or_equal_op f f1 f2-stepIEEE_Float_Is_Greater_Or_Equal vn = sortErr (ieee_float_is_greater_or_equal (fvalues vn)) "sort check"---ieee_float_op :: String -> ([Funcons] -> Funcons)-               -> (Double -> Double -> Double) -                -> Double -> Values -> [Values] -> Rewrite Rewritten-ieee_float_op str cons f b format vs-    | all (isIEEEFormat format) vs = rewriteTo $ FValue $ IEEE_Float_64-        $ foldr f b $ map (doubleFromIEEEFormat format) vs-    | otherwise = sortErr (cons (map FValue vs)) err-    where   err     = str ++ " not applied to ieee_floats"--ieee_float_add = applyFuncon "ieee-float-add"-ieee_float_add_op (format:vs) = ieee_float_op "ieee_float-add" ieee_float_add (+) 0 format vs-ieee_float_add_op [] = sortErr (ieee_float_add [listval []]) "ieee-float-add not applied to a format and a list of floats"--ieee_float_multiply = applyFuncon "ieee-float-multiply"-ieee_float_multiply_op (format:vs) = ieee_float_op "ieee_float-multiply" ieee_float_multiply (*) 1 format vs-ieee_float_multiply_op [] = sortErr (ieee_float_multiply [listval []]) "ieee-float-multiply not applied to a format and a list of floats"--ieee_float_divide = applyFuncon "ieee-float-divide"-ieee_float_divide_op format vx vy-    | isIEEEFormat format vx && isIEEEFormat format vy =-        let f1 = doubleFromIEEEFormat format vx-            f2 = doubleFromIEEEFormat format vy-        in rewriteTo $ FValue $ IEEE_Float_64 $ (f1 / f2)-ieee_float_divide_op ft vx vy = sortErr (ieee_float_divide [FValue ft,FValue vx, FValue vy])-                         "ieee-float-divide not applied to a format and ieee-floats"--ieee_float_remainder = applyFuncon "ieee-float-remainder"-ieee_float_remainder_op format vx vy-    | isIEEEFormat format vx =-        let f1 = doubleFromIEEEFormat format vx-            f2 = doubleFromIEEEFormat format vy-        in rewriteTo $ FValue $ IEEE_Float_64 $ (f1 `mod'` f2)-ieee_float_remainder_op ft vx vy = sortErr (ieee_float_remainder [FValue ft,FValue vx, FValue vy])-                         "ieee-float-remainder not applied to a format and ieee-floats"--ieee_float_negate = applyFuncon "ieee-float-negate"-ieee_float_negate_op format vx-    | isIEEEFormat format vx = let f1 = doubleFromIEEEFormat format vx-                               in rewriteTo $ FValue $ IEEE_Float_64 (-f1)-    | otherwise = sortErr (ieee_float_negate [FValue format,FValue vx]) "ieee-float-negate not applied to ieee-float"--ieee_float_subtract = applyFuncon "ieee-float-subtract"-ieee_float_subtract_op format vx vy-    | isIEEEFormat format vx && isIEEEFormat format vy =-        let f1 = doubleFromIEEEFormat format vx-            f2 = doubleFromIEEEFormat format vy-        in rewriteTo $ FValue $ IEEE_Float_64 $ (f1 - f2)-ieee_float_subtract_op ft vx vy = sortErr (ieee_float_subtract [FValue ft, FValue vx, FValue vy])-                         "ieee-float-subtract not applied to a format and ieee-floats"--ieee_float_float_power = applyFuncon "ieee-float-float-power"-ieee_float_power_op format vx vy-    | isIEEEFormat format vx && isIEEEFormat format vy =-        let f1 = doubleFromIEEEFormat format vx-            f2 = doubleFromIEEEFormat format vy-        in rewriteTo $ FValue $ IEEE_Float_64 $ (f1 ** f2)-ieee_float_power_op ft vx vy = sortErr (ieee_float_float_power [FValue ft, FValue vx, FValue vy])-                         "ieee-float-power not applied to a format and ieee-floats"--ieee_float_is_less = applyFuncon "ieee-float-is-less"-ieee_float_is_less_op format vx vy-    | isIEEEFormat format vx && isIEEEFormat format vy =-        let f1 = doubleFromIEEEFormat format vx-            f2 = doubleFromIEEEFormat format vy-        in rewriteTo $ FValue $ tobool (f1 < f2)-ieee_float_is_less_op ft vx vy = sortErr (ieee_float_is_less [FValue ft, FValue vx, FValue vy])-                         "ieee-float-is-less not applied to a format and ieee-floats"--ieee_float_is_greater = applyFuncon "ieee-float-is-greater"-ieee_float_is_greater_op format vx vy-    | isIEEEFormat format vx && isIEEEFormat format vy =-        let f1 = doubleFromIEEEFormat format vx-            f2 = doubleFromIEEEFormat format vy-        in rewriteTo $ FValue $ tobool (f1 > f2)-ieee_float_is_greater_op ft vx vy = sortErr (ieee_float_is_greater [FValue ft, FValue vx, FValue vy])-                         "ieee-float-is-greater not applied to a format and ieee-floats"--ieee_float_is_less_or_equal = applyFuncon "ieee-float-is-less-or-equal"-ieee_float_is_less_or_equal_op format vx vy-    | isIEEEFormat format vx && isIEEEFormat format vy =-        let f1 = doubleFromIEEEFormat format vx-            f2 = doubleFromIEEEFormat format vy-        in rewriteTo $ FValue $ tobool (f1 <= f2)-ieee_float_is_less_or_equal_op ft vx vy = sortErr (ieee_float_is_less_or_equal [FValue ft,FValue vx, FValue vy])-                         "ieee-float-is-less-or-equal not applied to a format and ieee-floats"--ieee_float_is_greater_or_equal = applyFuncon "ieee-float-is-greater-or-equal"-ieee_float_is_greater_or_equal_op format vx vy-    | isIEEEFormat format vx && isIEEEFormat format vy =-        let f1 = doubleFromIEEEFormat format vx-            f2 = doubleFromIEEEFormat format vy-        in rewriteTo $ FValue $ tobool (f1 >= f2)-ieee_float_is_greater_or_equal_op ft vx vy = sortErr (ieee_float_is_greater_or_equal [FValue ft,FValue vx, FValue vy])-                         "ieee-float-is-greater-or-equal not applied to a format and ieee-floats"---isIEEEFormat :: Values -> Values -> Bool-isIEEEFormat (ADTVal "binary32" _) (IEEE_Float_32 _) = True-isIEEEFormat (ADTVal "binary64" _) (IEEE_Float_64 _) = True-isIEEEFormat _ _ = False--doubleFromIEEEFormat :: RealFloat a => Values -> Values -> Double-doubleFromIEEEFormat (ADTVal "binary64" _) (IEEE_Float_64 d) = d-doubleFromIEEEFormat _ _ = error "fromIEEEFormat"--
− manual/Funcons/Core/Values/Primitive/Numbers/Integers.hs 
@@ -1,87 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Values.Primitive.Numbers.Integers where--import Funcons.EDSL-import Funcons.Types--library = libFromList [-        ("integer-add", ValueOp integer_add_op)-    ,   ("integer-multiply", ValueOp integer_multiply_op)-    ,   ("integer-divide", ValueOp integer_divide_op)-    ,   ("integer-subtract", ValueOp integer_subtract_op)-    ,   ("integer-power", ValueOp integer_power_op)---    ,   ("integer-negate", ValueOp stepInteger_Negate)-    ,   ("integer-list", ValueOp stepInteger_List)-    ,   ("integer-modulo", ValueOp stepInteger_Modulo)-    ,   ("integer-absolute-value", ValueOp stepInteger_Absolute_Value) -    ]--integer_op :: String -> ([Funcons] -> Funcons)-                     -> (Integer -> Integer -> Integer) -                     -> Integer -> [Values] -> Rewrite Rewritten -integer_op str cons f b vs | all isInt vs = -    rewriteTo $ int_ $ fromInteger $ foldr f b $ map toInt vs-                           | otherwise = sortErr (cons (map FValue vs)) err-    where   isInt v | Int _ <- upcastIntegers v = True-                    | otherwise = False-            toInt v | Int i <- upcastIntegers v = i-                    | otherwise = error err-            err     = str ++ " not applied to integers"--integer_add_ = FApp "integer-add" . FTuple--integer_add_op vs = integer_op "integer-add" integer_add_ (+) 0 vs--integer_multiply_ = FApp "integer-multiple" . FTuple-integer_multiply_op vs = integer_op "integer-multiply" integer_multiply_ (*) 1 vs--integer_divide_ = FApp "integer-divide" . FTuple-integer_divide_op [vx,vy]-    | (Int x,Int y) <- (upcastIntegers vx, upcastIntegers vy) = -        rewriteTo $ int_ $ fromInteger (x `div` y)-    | True = sortErr (integer_divide_ [FValue vx, FValue vy]) "integer-divide not applied to ints" -integer_divide_op vx = sortErr (integer_divide_ (fvalues vx)) "integer-divide not applied to two arguments" --integer_subtract = applyFuncon "integer-subtract"-integer_subtract_op [vx,vy]-    | (Int x, Int y) <- (upcastIntegers vx, upcastIntegers vy)= -        rewriteTo $ int_ $ fromInteger (x - y)-    | otherwise = sortErr (applyFuncon "integer-subtract" [FValue vx, FValue vy])-                            "integer-subtract not applied to ints"-integer_subtract_op v = sortErr (applyFuncon "integer-subtract" (fvalues v)) "integer-subtract should receive two integers"--integer_power = applyFuncon "integer-power"-integer_power_op [vx, vy]-    | (Int x, Int y) <- (upcastIntegers vx, upcastIntegers vy) = -        rewriteTo $ int_ $ fromInteger $(x ^ y)-integer_power_op vx = sortErr (applyFuncon "integer-power" (fvalues vx))-                            "integer-power not applied to two integers"--integer_negate = applyFuncon "integer-negate"-stepInteger_Negate [v]-    | (Int i) <- upcastIntegers v = rewriteTo $ int_ (- (fromInteger i))-stepInteger_Negate vs = sortErr (integer_negate (fvalues vs)) "integer-negate not applied to an integer"--integer_list = applyFuncon "integer-list"-stepInteger_List [vi1,vi2]-    | (Int i1, Int i2) <- (upcastIntegers vi1, upcastIntegers vi2)-            = rewriteTo $ FValue $ List (map mk_integers [i1.. i2])-stepInteger_List vs = sortErr (integer_list (fvalues vs)) "sort check: integer-list(I,J)"--integer_modulo = applyFuncon "integer-modulo"-stepInteger_Modulo [i1,i2] = integer_modulo_op i1 i2-stepInteger_Modulo vs = sortErr (integer_modulo (fvalues vs)) -                            "sort check: integer-modulo(I1,I2)"-integer_modulo_op vx vy-    | (Int x,Int y) <- (upcastIntegers vx, upcastIntegers vy)= -        rewriteTo $ int_ $ fromInteger (x `mod` y)-integer_modulo_op vx vy = sortErr (integer_modulo [FValue vx, FValue vy])-                         "integer-modulo not applied to ints"--integer_absolute_value = applyFuncon "integer-absolute-value"-stepInteger_Absolute_Value [v]-        | Int  i <- upcastIntegers v = rewriteTo $ FValue $ mk_integers (Prelude.abs i)-stepInteger_Absolute_Value vs = sortErr (integer_absolute_value $ fvalues vs) -                                    "sort check: integer-absolute-value(I1)"-
− manual/Funcons/Core/Values/Primitive/Numbers/RationalsBuiltin.hs 
@@ -1,64 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Funcons.Core.Values.Primitive.Numbers.RationalsBuiltin where--import Funcons.EDSL-import Funcons.Types-import Funcons.Core.Values.Primitive.BoolBuiltin--library = libFromList [-        ("is-less", ValueOp is_less_op)-    ,   ("is-less-or-equal", ValueOp is_less_or_equal_op)-    ,   ("is-greater", ValueOp is_greater_op)-    ,   ("is-greater-or-equal", ValueOp is_greater_or_equal_op)-    ,   ("rational-to-ieee-float", ValueOp stepRational_To_IEEE_Float)-    ,   ("add", ValueOp add_op)-    ]--is_less_ = applyFuncon "is-less" -is_less_op [vx, vy]-    | (Rational x, Rational y) <- (upcastRationals vx, upcastRationals vy)-        = rewriteTo $ FValue $ tobool (x < y)-is_less_op vs = sortErr (is_less_ (fvalues vs)) "is-less not applied to rationals"--is_less_or_equal_ = FApp "is-less-or-equal" . FTuple-is_less_or_equal_op [vx, vy]-    | (Rational x, Rational y) <- (upcastRationals vx, upcastRationals vy)-        = rewriteTo $ FValue $ tobool (x <= y) -is_less_or_equal_op vs = sortErr (is_less_or_equal_ (fvalues vs)) -                            "is_less_or_equal not applied to two arguments"--is_greater_ = FApp "is-greater" . FTuple-is_greater_op [vx, vy]-    | (Rational x, Rational y) <- (upcastRationals vx, upcastRationals vy)-        = rewriteTo $ FValue $ tobool (x > y) -is_greater_op vs = sortErr (is_greater_ (fvalues vs)) "is-greater not applied to two arguments"--is_greater_or_equal_ = FApp "is-greater-or-equal" . FTuple-is_greater_or_equal_op [vx, vy]-    | (Rational x, Rational y) <- (upcastRationals vx, upcastRationals vy)-        = rewriteTo $ FValue $ tobool (x >= y) -is_greater_or_equal_op vs = sortErr (is_greater_or_equal_ (fvalues vs)) -                            "is-greater-or-equal not applied to rationals"--stepRational_To_IEEE_Float [f, vn]-  |  Rational r <- upcastRationals vn = rewriteTo $ FValue $ IEEE_Float_64 (fromRational r)-stepRational_To_IEEE_Float vs = sortErr (applyFuncon "rational-to-ieee-float" (fvalues vs)) -                                    "rational-to-ieee-float not applied to a rational"--rational_op:: String -> ([Funcons] -> Funcons)-                   -> (Rational -> Rational -> Rational) -                    -> Rational -> [Values] -> Rewrite Rewritten-rational_op str cons f b vs | all isRat vs = rewriteTo $ rational_ $ foldr f b $ map toRat vs-                            | otherwise = sortErr (cons (fvalues vs)) err-    where   isRat v | Rational _ <- upcastRationals v = True-                    | otherwise = False-            toRat v | Rational r <- upcastRationals v = r-                    | otherwise = error err-            err     = str ++ " not applied to rationals"---add = applyFuncon "add"-add_op = rational_op "add" add (+) 0--
manual/Funcons/Core/Values/Primitive/StringsBuiltin.hs view
@@ -3,70 +3,12 @@ module Funcons.Core.Values.Primitive.StringsBuiltin where  import Funcons.EDSL-import Funcons.Types--import Numeric +import Funcons.Types hiding (stepTo_String, to_string_)+import qualified Funcons.Operations as VAL  library = libFromList [-        ("decimal-natural", ValueOp decimal_natural_op)-    ,   ("string-append", ValueOp string_append_op) -    ,   ("decimal-rational", ValueOp stepDecimal_Rational)-    ,   ("string-to-list", ValueOp stepString_To_List)-    ,   ("list-to-string", ValueOp stepList_To_String)-    ,   ("to-string", ValueOp stepTo_String)-    ,   ("string", ValueOp stepString)+        ("to-string", fromValOp to_string_ VAL.to_string_)     ] -stepString_To_List [String s] = rewriteTo $ listval $ map (Ascii . fromEnum) s-stepString_To_List vn = sortErr (applyFuncon "string-to-list" (fvalues vn)) "sort check"---stepString vs -    | all isChar_ vs = rewriteTo $ string_ (map fromChar vs)-    | otherwise  = sortErr (applyFuncon "string" (fvalues vs)) -        "string not applied unicode characters"-    where isChar_ v | Char _ <- upcastUnicode v = True-                    | otherwise = False-          fromChar v | Char c <- upcastUnicode v = c-                     | otherwise = error "upcast in 'string'"--decimal_natural_ = FApp "decimal-natural" . FTuple -decimal_natural_op [String s] = rewriteTo $ nat_ (read s)-decimal_natural_op vs = sortErr (decimal_natural_ (fvalues vs)) -                            "decimal-natural not applied to strings"---stepDecimal_Rational [String s] = rewriteTo $ rational_ (readRational s)-stepDecimal_Rational v          = sortErr (applyFuncon "decimal-rational" (fvalues v))-                                     "decimal-natural not applied to a string"--stepList_To_String [List cs]    = list_to_string_op cs-stepList_To_String vs            = sortErr (applyFuncon "list-to-string" (fvalues vs)) -                                    "list-to-string not applied to a list"---- | --- Concatenate a sequence of strings.-string_append_ :: [Funcons] -> Funcons-string_append_ = applyFuncon "string-append"-string_append_op vs = maybe exc (rewriteTo . string_) $ foldr (.++.) (Just []) vs- where  (.++.) (String s)   = fmap (s ++)-        (.++.) _            = const Nothing-        exc = sortErr (applyFuncon "string-append" [listval vs]) -                "string-append not applied to strings"--list_to_string_op vs | all isAscii_ vs = rewriteTo $ string_ $  map ascii2char vs-                     | otherwise = sortErr (applyFuncon "list-to-string" (fvalues vs)) -                            "list-to-string not applied to a list of ascii-characters"- where ascii2char (Ascii i) = toEnum i-       ascii2char _         = error "list-to-string not applied to a list of ascii-characters"-       isAscii_ (Ascii i) = True-       isAscii_ _         = False--readRational :: String -> Rational-readRational = fst . head . readFloat--stepTo_String [String str]      = rewriteTo $ string_(str)-stepTo_String [Rational r]      = rewriteTo $ string_(show (fromRational r))-stepTo_String [Ascii o]         = rewriteTo $ string_([toEnum o])-stepTo_String vs                = rewriteTo $ string_(showValues (safe_tuple_val vs))+to_string_ = applyFuncon "to-string"
+ manual/Funcons/Core/Values/TypesBuiltin.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE OverloadedStrings, LambdaCase #-}++module Funcons.Core.Values.TypesBuiltin where++import Funcons.EDSL +import qualified Funcons.Operations as VAL++library = libFromList [+    ("datatype-values", fromNullaryValOp datatype_values_ VAL.datatype_values_)+  , ("ground-values", fromNullaryValOp ground_values_ VAL.ground_values_)+  , ("ground-vals", fromNullaryValOp ground_values_ VAL.ground_values_)+  , ("none", fromNullaryValOp none_ VAL.none_)+  , ("defined-values", fromNullaryValOp defined_values_ VAL.defined_values_)+  , ("nothing", fromNullaryValOp nothing_ VAL.nothing_)+  , ("types", fromNullaryValOp types_ VAL.types_)+  , ("value-types", fromNullaryValOp value_types_ VAL.value_types_)+  ]++types_ = applyFuncon "types"+value_types_ = applyFuncon "value-types"+defined_values_ = applyFuncon "defined-values"+nothing_ = applyFuncon "nothing"+datatype_values_ = applyFuncon "datatype-values" +none_ = applyFuncon "none"+ground_values_ = applyFuncon "ground-values"
+ manual/Funcons/MetaProgramming.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE OverloadedStrings, LambdaCase #-}++-- |+-- This module implements HGMPification of funcons based on Berger et al. (2017)+-- (First-order.)+module Funcons.MetaProgramming where++import Funcons.MSOS+import Funcons.EDSL+import Funcons.Types+import Funcons.Patterns+import Funcons.RunOptions+import Funcons.Simulation++import Data.Text (pack, unpack)+import qualified Data.Map as M++-- | This function implements the ==CT=> relation.+-- Compiling programs to executable funcons terms,+-- removing occurrences of `meta-up`, `meta-down` and `meta-let` and `meta-bound`.+ctRel :: Funcons -> MSOS Funcons+ctRel f = case f of+  FName nm                        -> return f +  FApp "meta-up" [m]              -> ulRel m+  FApp "meta-down" [m]            -> staticEval m+  FApp "meta-let" [FValue nm,m,n] | isString_ nm -> do +    v <- evalRel =<< ctRel m+    menv <- getInh "env"+    let env' = case menv of +                Map env -> Map (M.insert nm v env)+                _       -> Map (M.singleton nm v)+    withInh "env" env' (ctRel n)+  FApp nm arg                     -> FApp nm <$> mapM ctRel arg+--  FList fs                        -> FList <$> mapM ctRel fs+  FSet fs                         -> FSet <$> mapM ctRel fs+  FMap fs                         -> FMap <$> mapM ctRel fs+  FValue v                        -> return (FValue v)+  _                               -> liftRewrite (sortErr f ("ctRel not defined"))+  where staticEval m = ctRel m >>= evalRel >>= liftRewrite . dlRel  ++-- | This function implements the ==UL=> relation.+-- Translating a funcon into its meta-representation+ulRel :: Funcons -> MSOS Funcons+ulRel f = case f of+  FName nm              -> return $ ast_ [string_ (unpack nm)]+  FApp "meta-down" [f]  -> ctRel f+  FApp "meta-up" [m]    -> ulRel m >>= ulRel+  FApp nm fs            -> ast_ . (string_ (unpack nm):) <$> mapM ulRel fs+--  FList fs              -> ast_ . (string_ "list":) <$> mapM ulRel fs+  FSet fs               -> ast_ . (string_ "set":) <$> mapM ulRel fs+  FMap fs               -> ast_ . (string_ "map":) <$> mapM ulRel fs+  FValue v              -> return $ ast_ [type_ (tyOf v), FValue v]+  -- What TODO with type annotations? +  _                     -> liftRewrite (sortErr f ("ulRel not defined"))++-- | This function implements the ==DL=> relation.+-- Translating a meta-representation of a program into the actual program+dlRel :: Values -> Rewrite Funcons+dlRel v = case v of +  VMeta tag -> dlRel' tag+  _         -> sortErr (meta_down_ (fvalues [v])) "meta-down not applied to a meta-representation"+ where+    dlRel' :: TaggedSyntax -> Rewrite Funcons +    dlRel' t = case t of +      TagType ty lit                  -> return (FValue lit)+      TagName nm []                   -> return $ FName nm+      TagName "set" vs                -> FSet <$> mapM dlRel vs+      TagName "map" vs                -> FMap <$> mapM dlRel vs+      TagName nm vs                   -> FApp nm <$> mapM dlRel vs++evalRel :: Funcons -> MSOS Values+evalRel f = evalFuncons f >>= \case +  Right [v]   -> return v+  Right vs    -> liftRewrite $ internal "meta evaluation yields a sequence of values"+  Left f'     -> evalRel f'+  where setGlobal f ctxt = ctxt { ereader = (ereader ctxt) { global_fct = f } }++compile :: FunconLibrary -> TypeRelation -> Funcons -> Funcons -> Funcons+compile lib tyenv fenv f = +  case runSimIO (runMSOS process (cmp_MSOSReader lib tyenv f) cmp_MSOSState) M.empty of+    ((Left ie , _,_), _) -> error ("failed to compile\n" ++ showIException ie)+    ((Right f, _, _), _) -> f  +  where process = do  +          env <- evalRel fenv+          putMut "atom-gen" (Atom "0")+          putMut "store" (Map M.empty)+          withInh "env" env (ctRel f)+ +translationStep :: ([Funcons] -> Funcons) -> StrictFuncon+translationStep f vs = compstep $ do  fs <- liftRewrite (mapM dlRel vs)+                                      Left <$> ulRel (f fs)++cmp_MSOSReader lib env f = MSOSReader cmp_RewriteReader M.empty M.empty (fread True)+  where cmp_RewriteReader = RewriteReader lib env defaultRunOptions f f  +--cmp_MSOSWriter = MSOSWriter mempty mempty mempty+cmp_MSOSState = MSOSState M.empty M.empty (RewriteState)++library :: FunconLibrary+library = libFromList [+--    ("meta-up", NonStrictFuncon step_meta_up)  -- static funcon+--  , ("meta-down", StrictFuncon step_meta_down) -- static funcon+    ("eval", StrictFuncon step_meta_eval)+  , ("code", NonStrictFuncon step_code)+  , ("ast", StrictFuncon step_ast)+  , ("type-of", StrictFuncon step_ty_of)+  ]++meta_up_ = applyFuncon "meta-up"+meta_down_ = applyFuncon "meta-down"+meta_let_ = applyFuncon "meta-let"++eval_ = applyFuncon "eval"+code_ = applyFuncon "code"+step_meta_eval :: [Values] -> Rewrite Rewritten+step_meta_eval [v] = dlRel v >>= rewriteTo+step_meta_eval fs = sortErr (eval_ (fvalues fs)) "eval not applied to one argument"++step_code :: [Funcons] -> Rewrite Rewritten+step_code [f] = compstep (toStepRes <$> ulRel f)+step_code fs = sortErr (code_ fs) "code not applied to a single term"++ast_ = applyFuncon "ast"+step_ast :: [Values] -> Rewrite Rewritten+step_ast vs@(s:args) | isString_ s = +  Funcons.Patterns.isInTupleType args [(ASTs, Just StarOp)] >>= \case+    True  -> rewriteTo $ FValue $ VMeta (TagName (pack (unString s)) args)+    False -> sortErr (ast_ (fvalues vs)) "'ast' is not applied to a string and a sequence of meta-representations"+step_ast vs@[ComputationType (Type ty), v] = Funcons.Patterns.isInType v ty >>= \case+  True  -> rewriteTo $ FValue $ VMeta (TagType ty v)+  False -> sortErr (ast_ (fvalues vs)) "type-checking failed during evaluation of 'ast'"+step_ast vs = sortErr (ast_ (fvalues vs)) "'ast' is not applied to a string or not to a type and a member of that type"++type_of_ = applyFuncon "type-of"+step_ty_of :: [Values] -> Rewrite Rewritten+step_ty_of [v] = rewriteTo $ type_ $ tyOf v+step_ty_of vs = sortErr (type_of_ (fvalues vs)) "type-of not applied to a single value"++--TODO perhaps the parser should be extended to recognise "ast-" prefixes+-- which are translated into applications of VMeta
src/Funcons/Core.hs view
@@ -9,18 +9,18 @@ --  exports have been generated. -- --If a funcon is called 'handle-thrown', its smart constructor is called ---'handle_thrown_' (hypens replaced by underscores and an additional underscore+--'handle_thrown_' (hyphens replaced by underscores and an additional underscore --at the end). Each smart constructors has a single argument, a list --(of type (['Funcons']) representing the actual arguments of a funcon application. -- For example, the funcon 'integer-add' can be applied to an arbitrary number --of (integer) arguments, e.g. 'integer_add_' ['int_' 3, 'int_' 4, 'int_' 5]. module Funcons.Core (-    list_, tuple_, set_, int_, nat_, string_,+    int_, nat_,     module Funcons.Core.Library,     module Funcons.Core.Manual) where -import Funcons.Types -- Haddock dependency+import Funcons.Types hiding (set_) -- Haddock dependency import Funcons.Core.Library hiding (entities, funcons, types)-import Funcons.Core.Manual hiding (entities, funcons, types)+import Funcons.Core.Manual hiding (entities, funcons, types, unicode_, ascii_character_)
src/Funcons/EDSL.hs view
@@ -6,20 +6,21 @@ -- Module "Funcons.Tools" provides functions for creating executables. module Funcons.EDSL (     -- * Funcon representation-        Funcons(..), Values(..), Types(..), ComputationTypes(..),SeqSortOp(..),+        Funcons(..), Values(..), Types(..), ComputationTypes(..),SeqSortOp(..),TaggedSyntax(..),             applyFuncon,     -- ** Smart construction of funcon terms+        app0_, app1_, app2_, app3_,     -- *** Funcon terms-        list_, tuple_, set_, map_empty_, empty_tuple_,+        tuple_, list_, set_, map_, vec_, env_fromlist_, none__,     -- *** Values-        int_, nat_, string_,+        int_, nat_, float_, ieee_float_32_, ieee_float_64_, string_, string__, atom_,     -- *** Types-        values_, integers_, strings_, unicode_characters_,+        values_, integers_, atoms_, unicode_characters_, vectors_, type_,     -- ** Pretty-print funcon terms-        showValues, showFuncons, showTypes,+        showValues, showValuesSeq, showFuncons, showFunconsSeq, showTypes, showTerms, showOp,     -- ** Is a funcon term a certain value?-        isVal, isString, isInt, isNat, isList, isMap, isType,-        isVec, isAscii, isChar, isTup, isId, isThunk, +        isVal, isInt, isNat, isList, isMap, isType,+        isVec, isAscii, isChar, isTup, isString, isString_, unString,      -- ** Up and downcasting between funcon terms          downcastValue, downcastType, downcastValueType,         upcastNaturals, upcastIntegers, upcastRationals, upcastUnicode,@@ -28,38 +29,45 @@               NonStrictFuncon, ValueOp, NullaryFuncon,      -- *** Funcon libraries-    FunconLibrary, libEmpty, libUnion, libUnions, libFromList, library,+    FunconLibrary, libEmpty, libUnion, libOverride, libUnions, libOverrides, libFromList, Funcons.EDSL.library, fromNullaryValOp, fromValOp, fromSeqValOp,     -- ** Implicit & modular propagation of entities     MSOS, Rewrite, Rewritten,      -- *** Helpers to create rewrites & step rules-            rewriteTo, stepTo, compstep, rewritten, premiseStep, premiseEval,+            rewriteTo, rewriteSeqTo, stepTo, stepSeqTo, +              compstep, rewritten, premiseStep, premiseEval,                 norule, sortErr, partialOp,     -- *** Entities and entity access         Inherited, getInh, withInh,         Mutable, getMut, putMut,         Output, writeOut, readOut, -        Control, raiseSignal, receiveSignal, -        Input, consumeInput, withExtraInput, withExactInput,  +        Control, raiseSignal, receiveSignals, +        Input, withExtraInput, withExactInput,                    -- * CBS compilation      -- $cbsintro      -- ** Funcon representation with meta-variables-        FTerm(..), Env, emptyEnv, +        FTerm(..), Env, emptyEnv, fvalues,     -- *** Defining rules          rewriteTermTo,stepTermTo,premise,     -- *** Entity access         withInhTerm, getInhPatt, putMutTerm, getMutPatt, writeOutTerm, readOutPatt, -        receiveSignalPatt, raiseTerm, assignInput, withExtraInputTerms, withExactInputTerms, +        receiveSignalPatt, raiseTerm, matchInput, withExtraInputTerms, withExactInputTerms,+        withControlTerm, getControlPatt,     -- ** Backtracking-        evalRules, SideCondition(..), sideCondition,  lifted_sideCondition,-+        evalRules, stepRules, rewriteRules,+           SideCondition(..), sideCondition,  lifted_sideCondition,     -- ** Pattern Matching-        VPattern(..), FPattern(..), -            vsMatch, fsMatch,-            lifted_vsMatch, lifted_fsMatch,-       +        VPattern(..), FPattern(..), TPattern(..), +            vsMatch, fsMatch, f2vPattern,+            lifted_vsMatch, lifted_fsMatch, pat2term, vpat2term, typat2term,+    -- ** Meta-environment+        envRewrite, envStore, lifted_envRewrite, lifted_envStore,+      +    -- * Type substitution+    TypeEnv, TyAssoc(..), HasTypeVar(..), limitedSubsTypeVar, limitedSubsTypeVarWildcard, +      -- * Tools for creating interpreters        -- For more explanation see "Funcons.Tools"@@ -68,53 +76,65 @@     -- ** Default entity values         EntityDefaults, EntityDefault(..),     -- ** Type environments-        TypeEnv, DataTypeMembers(..), DataTypeAlt(..),  -            typeLookup, typeEnvUnion, typeEnvUnions, typeEnvFromList, emptyTypeEnv,+        TypeRelation, TypeParam(..), DataTypeMembers(..), DataTypeAltt(..), +            typeLookup, typeEnvUnion, typeEnvUnions, typeEnvFromList, emptyTypeRelation,     )where  import Funcons.MSOS import Funcons.Types+import qualified Funcons.Operations as VAL import Funcons.Entities import Funcons.Patterns import Funcons.Substitution import Funcons.Printer+import Funcons.TypeSubstitution  import Control.Arrow ((***))  congruence1_1 :: Name -> Funcons -> Rewrite Rewritten-congruence1_1 fnm = compstep . premiseStepApp app -    where app f = applyFuncon fnm [f] +congruence1_1 fnm = compstep . premiseStepApp (flattenApp app) +    where app = applyFuncon fnm  congruence1_2 :: Name -> Funcons -> Funcons -> Rewrite Rewritten-congruence1_2 fnm arg1 arg2 = compstep $ premiseStepApp app arg1 -    where app f = applyFuncon fnm [f, arg2]+congruence1_2 fnm arg1 arg2 = compstep $ premiseStepApp (flattenApp app) arg1 +    where app fs = applyFuncon fnm (fs++[arg2])  congruence2_2 :: Name -> Funcons -> Funcons -> Rewrite Rewritten-congruence2_2 fnm arg1 arg2 = compstep $ premiseStepApp app arg2-    where app f = applyFuncon fnm [arg1, f]+congruence2_2 fnm arg1 arg2 = compstep $ premiseStepApp (flattenApp app) arg2+    where app fs = applyFuncon fnm (arg1:fs)  congruence1_3 :: Name -> Funcons -> Funcons -> Funcons -> Rewrite Rewritten-congruence1_3 fnm arg1 arg2 arg3 = compstep $ premiseStepApp app arg1 -    where app f = applyFuncon fnm [f, arg2, arg3]+congruence1_3 fnm arg1 arg2 arg3 = compstep $ premiseStepApp (flattenApp app) arg1 +    where app fs = applyFuncon fnm (fs ++ [arg2, arg3])  congruence2_3 :: Name -> Funcons -> Funcons -> Funcons -> Rewrite Rewritten-congruence2_3 fnm arg1 arg2 arg3 = compstep $ premiseStepApp app arg2 -    where app f = applyFuncon fnm [arg1, f, arg3]+congruence2_3 fnm arg1 arg2 arg3 = compstep $ premiseStepApp (flattenApp app) arg2 +    where app fs = applyFuncon fnm (arg1 : fs ++ [arg3])  congruence3_3 :: Name -> Funcons -> Funcons -> Funcons -> Rewrite Rewritten-congruence3_3 fnm arg1 arg2 arg3 = compstep $ premiseStepApp app arg3 -    where app f = applyFuncon fnm [arg1, arg2, f]+congruence3_3 fnm arg1 arg2 arg3 = compstep $ premiseStepApp (flattenApp app) arg3 +    where app fs = applyFuncon fnm ([arg1, arg2] ++ fs) +flattenApp :: ([Funcons] -> Funcons) -> (StepRes -> StepRes) +flattenApp app res = case res of +  Left f    -> toStepRes (app [f])+  Right vs  -> toStepRes (app (map FValue vs))++-- | Create an environment from a list of bindings (String to Values)+-- This function has been introduced for easy expression of the+-- semantics of builtin identifiers +env_fromlist_ :: [(String, Funcons)] -> Funcons+env_fromlist_ = FMap . concatMap (\(k,v) -> [string_ k, v])++ -- | A funcon library with funcons for builtin types. library :: FunconLibrary-library = libUnions [unLib, nullLib, binLib, floatsLib, bitsLib-                    ,boundedLib]+library = libUnions [unLib, nullLib, binLib, floatsLib,boundedLib]  where         nullLib = libFromList (map (id *** mkNullary) nullaryTypes)         unLib   = libFromList (map (id *** mkUnary) unaryTypes)         binLib  = libFromList (map (id *** mkBinary) binaryTypes)         floatsLib = libFromList (map (id *** mkFloats) floatTypes)-        bitsLib = libFromList (map (id *** mkBits) bitsTypes)         boundedLib = libFromList (map (id *** mkBounded) boundedIntegerTypes)          mkNullary :: Types -> EvalFunction @@ -125,35 +145,42 @@             where   sfuncon [ADTVal "binary32" _] = rewritten $ typeVal $ cons Binary32                     sfuncon [ADTVal "binary64" _] = rewritten $ typeVal $ cons Binary64                     sfuncon vs = sortErr (tuple_val_ vs) "ieee-float not applied to ieee-format"--        mkBits :: (Int -> Types) -> EvalFunction-        mkBits cons = StrictFuncon sfuncon-            where   sfuncon [v] | Nat n <- upcastNaturals v = -                                        rewritten $ typeVal $ cons (fromInteger n)-                    sfuncon vs = sortErr (tuple_val_ vs) "bits not applied to naturals" --        mkBounded :: (Integer -> Integer -> Types) -> EvalFunction+        mkBounded :: (Integer -> Types) -> EvalFunction         mkBounded cons = StrictFuncon sfuncon-            where   sfuncon [v1,v2] -                        | Int i1 <- upcastIntegers v1, Int i2 <- upcastIntegers v2 = -                                    rewritten $ typeVal $ cons i1 i2-                    sfuncon v = sortErr (tuple_val_ v) "bounded-integers not applied to two integers" +            where   sfuncon [v1] +                        | Int i1 <- upcastIntegers v1 = +                                    rewritten $ typeVal $ cons i1+                    sfuncon v = sortErr (tuple_val_ v) "type not applied to an integer value"           mkUnary :: (Types -> Types) -> EvalFunction         mkUnary cons = StrictFuncon sfuncon             where sfuncon [ComputationType (Type x)]  = rewritten $ typeVal $ cons x-                  sfuncon  _                          = rewritten $ typeVal $ cons Values+                  sfuncon  _                          = rewritten $ typeVal $ cons VAL.Values          mkBinary :: (Types -> Types -> Types) -> EvalFunction         mkBinary cons = StrictFuncon sfuncon             where sfuncon [ComputationType (Type x), ComputationType (Type y)] =                      rewritten $ typeVal $ Maps x y-                  sfuncon _ = rewritten $ typeVal $ cons Values Values+                  sfuncon _ = rewritten $ typeVal $ cons VAL.Values VAL.Values +app0_ :: ([Funcons] -> Funcons) -> Funcons+app0_ cons = cons []++app1_ :: ([Funcons] -> Funcons) -> Funcons -> Funcons+app1_ cons x = cons [x]++app2_ :: ([Funcons] -> Funcons) -> Funcons -> Funcons -> Funcons+app2_ cons x y = cons [x,y]++app3_ :: ([Funcons] -> Funcons) -> Funcons -> Funcons -> Funcons -> Funcons+app3_ cons x y z = cons [x,y,z]+ + -- $cbsintro -- This section describes functions that extend the interpreter with -- backtracking and pattern-matching facilities. These functions -- are developed for compiling CBS funcon specifications to  -- Haskell. To read about CBS we refer to --- <http://plancomps.dreamhosters.com/taosd2015/ TAOSD2015>The functions can be +-- <http://plancomps.dreamhosters.com/wp-content/uploads/2016/02/jlamp-16.pdf JLAMP2016>. +-- The functions can be  -- used for manual development of funcons, although this is not recommended.
src/Funcons/Entities.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}  module Funcons.Entities (     -- * Accessing entities@@ -7,11 +8,12 @@         -- ** inherited         getInh, withInh, getInhPatt, withInhTerm,         -- ** control-        raiseSignal, receiveSignal, raiseTerm, receiveSignalPatt, +        raiseSignal, receiveSignals, raiseTerm, receiveSignalPatt,+        withControlTerm, getControlPatt,         -- ** output         writeOut, readOut, writeOutTerm, readOutPatt,         -- ** input-        assignInput, consumeInput, withExtraInput,withExactInput,+        matchInput, withExtraInput,withExactInput,             withExtraInputTerms, withExactInputTerms,     -- * Default entity values         EntityDefaults, EntityDefault(..), setEntityDefaults@@ -23,6 +25,7 @@ import Funcons.Exceptions import Funcons.Patterns +import Control.Applicative import Control.Arrow import qualified Data.Map as M import Data.Text@@ -40,16 +43,20 @@                     | DefControl Name                     | DefInput Name -setEntityDefaults :: EntityDefaults -> MSOS Funcons -> MSOS Funcons+setEntityDefaults :: EntityDefaults -> MSOS StepRes -> MSOS StepRes setEntityDefaults [] msos = msos setEntityDefaults ((DefMutable nm f):rest) msos =      liftRewrite (rewriteFuncons f) >>= \case -        ValTerm v -> putMut nm v >> setEntityDefaults rest msos+        ValTerm [v] -> putMut nm v >> setEntityDefaults rest msos+        ValTerm vs  -> liftRewrite $ exception f "default value evaluates to a sequence"         _           -> liftRewrite $ exception f "default value requires steps to evaluate" setEntityDefaults ((DefInherited nm f):rest) msos =      liftRewrite (rewriteFuncons f) >>= \case-        ValTerm v -> withInh nm v (setEntityDefaults rest msos)+        ValTerm [v] -> withInh nm v (setEntityDefaults rest msos)+        ValTerm vs  -> liftRewrite $ exception f "default value evaluates to a sequence"         _           -> liftRewrite $ exception f "default value requires steps to evaluate" +setEntityDefaults ((DefControl nm):rest) msos = +    withControl nm Nothing (setEntityDefaults rest msos)  setEntityDefaults (_:rest) msos = setEntityDefaults rest msos  ----------------------------------------------------@@ -67,7 +74,7 @@ getMut :: Name -> MSOS Values getMut key = do  rw <- giveMUT                  case M.lookup key rw of-                    Nothing -> error ("unknown mutable entity: " ++ unpack key)+                    Nothing -> return none__                      Just v  -> return v  -- | Variant of 'getMut' that performs pattern-matching.@@ -79,7 +86,7 @@ modifyMUT :: Name -> (Values -> Values) -> MSOS () modifyMUT key f = do    rw <- giveMUT                         newMUT (M.alter up key rw)- where  up Nothing  = error ("unknown mutable entity: " ++ unpack key) + where  up Nothing  = Just (f none__)          up (Just x) = Just (f x)  -- | Set the value of some mutable entity.@@ -89,7 +96,7 @@  -- | Variant of 'putMut' that applies substitution. putMutTerm :: Name -> FTerm -> Env -> MSOS ()-putMutTerm nm term env = liftRewrite (subsAndRewrite term env) >>= putMut nm  +putMutTerm nm term env = liftRewrite (subsAndRewritesToValue term env) >>= putMut nm    newMUT :: Mutable -> MSOS () newMUT rw = MSOS $ \ctxt mut-> return (Right(), mut {mut_entities = rw}, mempty)@@ -98,18 +105,21 @@ -- input -- | Consume a single value from the input stream. -- | Throws an 'unsufficient input' exception, if not enough input is available.-consumeInput :: Name -> MSOS Values+consumeInput :: Name -> MSOS Funcons  consumeInput nm = MSOS $ \ctxt mut ->     case M.lookup nm (inp_es mut) of-      Just (vss, mreadM) -> case attemptConsume vss of-              Just (v,vss') -> -                return (Right v, mut {inp_es = M.insert nm (vss',mreadM) (inp_es mut)},mempty)-              Nothing       -> case mreadM of-                    Nothing    -> return (Left (ctxt2exception (InsufficientInput nm) ctxt), mut, mempty)-                    Just readM -> do    v <- readM-                                        return (Right v, mut, mempty)-      Nothing            -> error ("unknown input entity " ++ unpack nm) +      Just (vss, mreadM) -> wrapAttempt ctxt mut vss mreadM +      Nothing            -> wrapAttempt ctxt mut [] (Just (def_fread ctxt nm))   where+    wrapAttempt ctxt mut vss mreadM = case attemptConsume vss of+      Just (v,vss') -> return +        (Right (FValue v), mut {inp_es = M.insert nm (vss',mreadM) (inp_es mut)},mempty)+      Nothing       -> case mreadM of+        Nothing -> return +          (Left (ctxt2exception (InsufficientInput nm) ctxt), mut, mempty)+        Just readM -> do    v <- readM+                            return (Right v, mut, mempty)+     attemptConsume :: [[a]] -> Maybe (a,[[a]])     attemptConsume []           = Nothing     attemptConsume ((v:vs):vss) = Just (v,vs:vss)@@ -128,48 +138,51 @@ withExactInput = withInput True  withInput :: Bool -> Name -> [Values] -> MSOS a -> MSOS a-withInput isExactInput nm vs (MSOS f) = MSOS $ \ctxt mut ->-  case M.lookup nm (inp_es mut) of-    Just (vss, mreadM) | let newInp = (vs:vss, if isExactInput then Nothing else mreadM) -> do+withInput isExactInput nm vs (MSOS f) = MSOS $ \ctxt mut -> do+  let provideInput newInp mreadM = do         (a,mut',wr') <- f ctxt mut{ inp_es = M.insert nm newInp (inp_es mut)}         let (res,vss'') = case (inp_es mut') M.! nm of                ([]:vss',_) -> (a, vss')                _           -> (Left(ctxt2exception(InsufficientInputConsumed nm) ctxt), vss'')         return (res, mut' {inp_es = M.insert nm (vss'',mreadM) (inp_es mut')}, wr')-    Nothing -> error ("unknown input entity " ++ unpack nm)+  case M.lookup nm (inp_es mut) of+    Just (vss, mreadM) -> +      provideInput (vs:vss, if isExactInput then Nothing else mreadM) mreadM+    Nothing -> provideInput ([vs], Nothing) Nothing --- | Variant of 'consumeInput' that binds the given 'MetaVar' to the consumed+-- | Variant of 'consumeInput' that matches the given `VPattern` to the consumed -- value in the given 'Env'. -assignInput :: Name -> MetaVar -> Env -> MSOS Env-assignInput nm var env = do -    v <- consumeInput nm-    return (envInsert var (ValueTerm v) env)+matchInput :: Name -> VPattern -> Env -> MSOS Env+matchInput nm pat env = do +    fs <- consumeInput nm+    vs <- liftRewrite (rewritesToValues fs)+    liftRewrite (vsMatch vs [pat] env) --- | Variant of withExtraInput' that performs substitution.+-- | Variant of 'withExtraInput' that performs substitution. withExtraInputTerms = withInputTerms False--- | Variant of withExactInput' that performs substitution.+-- | Variant of 'withExactInput' that performs substitution. withExactInputTerms = withInputTerms True  withInputTerms :: Bool -> Name -> [FTerm] -> Env -> MSOS a -> MSOS a withInputTerms b nm fs env msos = do-    vs <- liftRewrite (mapM (flip subsAndRewrite env) fs)+    vs <- liftRewrite (mapM (flip subsAndRewritesToValue env) fs)     withInput b nm vs msos  -- control -- | Receive the value of a control entity from a given 'MSOS' computation.-receiveSignal :: Name -> MSOS a -> MSOS (a, Maybe Values)-receiveSignal key (MSOS f) = MSOS (\ctxt mut -> do+receiveSignals :: [Name] -> MSOS a -> MSOS (a, [Maybe Values])+receiveSignals keys (MSOS f) = MSOS (\ctxt mut -> do     (e_a, mut1, wr1) <- f ctxt mut     case e_a of          Left err -> return (Left err, mut1, wr1)-        Right a  -> return (Right (a,maybe Nothing id $ M.lookup key (ctrl_entities wr1))-                        , mut1, wr1 {ctrl_entities = M.delete key (ctrl_entities wr1)}))+        Right a  -> return $ +          (Right (a, Prelude.map (find (ctrl_entities wr1)) keys)+                 , mut1, wr1 {ctrl_entities = Prelude.foldr M.delete (ctrl_entities wr1) keys}))+  where find m key = maybe Nothing id $ M.lookup key m  -- | Variant of 'receiveSignal' that performs pattern-matching.-receiveSignalPatt :: Name -> Maybe VPattern -> MSOS Env -> MSOS Env-receiveSignalPatt nm mpat msos = do-    (env, val) <- receiveSignal nm msos-    liftRewrite (vMaybeMatch val mpat env)+receiveSignalPatt :: Maybe Values -> Maybe VPattern -> Env -> MSOS Env+receiveSignalPatt mval mpat env = liftRewrite (vMaybeMatch mval mpat env)  -- | Signal a value of some control entity. raiseSignal :: Name -> Values -> MSOS ()@@ -178,15 +191,49 @@  -- | Variant of 'raiseSignal' that applies substitution. raiseTerm :: Name -> FTerm -> Env -> MSOS ()-raiseTerm nm term env = liftRewrite (subsAndRewrite term env) >>= raiseSignal nm +raiseTerm nm term env = liftRewrite (subsAndRewritesToValue term env) >>= raiseSignal nm  +-- downwards control+-- | Set the value of an downwards control entity. +-- The new value is /only/ set for 'MSOS' computation given as a third argument.+withControl :: Name -> Maybe Values -> MSOS a -> MSOS a+withControl key mfct (MSOS f) = MSOS (\ctxt mut  -> +    let ctxt' = ctxt { dctrl_entities = M.insert key mfct (dctrl_entities ctxt) } +    in f ctxt' mut)++withControlTerm :: Name -> Maybe FTerm -> Env -> MSOS a -> MSOS a+withControlTerm nm mterm env msos = do+    mfct <- case mterm of +              Nothing   -> return Nothing+              Just term -> Just <$> liftRewrite (substitute_signal term env)+    withControl nm mfct msos++-- | Get the value of an down control entity.+getControl :: Name -> MSOS (Maybe Values)+getControl key = do  +  ro <- giveCTRL+  case M.lookup key ro of+    Nothing   -> return Nothing+    Just mv   -> return mv++-- | Version of 'getControl' that applies pattern-matching.+getControlPatt :: Name -> Maybe VPattern -> Env -> MSOS Env+getControlPatt nm mpat env = do+    mpat' <- liftRewrite $ maybe (return Nothing) (fmap Just . flip substitute_patt_signal env) mpat+    mfct <- getControl nm+    liftRewrite (eval_catch (vMaybeMatch mfct mpat' env) >>= \case+      Left (_,_,PatternMismatch _)  -> return env --TODO suboptimal +      Left exc                      -> rewrite_rethrow exc+      Right env'                    -> return env')++ -- inherited  -- | Get the value of an inherited entity. getInh :: Name -> MSOS Values getInh key = do  ro <- giveINH                  case M.lookup key ro of-                    Nothing -> error ("unknown inherited entity: " ++ unpack key)+                    Nothing -> return none__                      Just v  -> return v  -- | Version of 'getInh' that applies pattern-matching.@@ -205,7 +252,7 @@ -- | Variant of 'withInh' that performs substitution. withInhTerm :: Name -> FTerm -> Env -> MSOS a -> MSOS a withInhTerm nm term env msos = do-    v <- liftRewrite $ (subsAndRewrite term env)+    v <- liftRewrite $ (subsAndRewritesToValue term env)     withInh nm v msos  -- output@@ -216,9 +263,8 @@  -- | Variant of 'writeOut' that applies substitution. writeOutTerm :: Name -> FTerm -> Env -> MSOS ()-writeOutTerm nm term env = liftRewrite (subsAndRewrite term env) >>= \case-    (List values) -> writeOut nm values-    v -> liftRewrite $ exception (FValue v) "Attempting to output a single value"+writeOutTerm nm term env = +  liftRewrite (subsAndRewritesToValues term env) >>= writeOut nm  -- | Read the values of a certain output entity. The output is obtained -- from the 'MSOS' computation given as a second argument.@@ -230,4 +276,4 @@ readOutPatt :: Name -> VPattern -> MSOS Env -> MSOS Env  readOutPatt key pat msos = do     (env, vals) <- readOut key msos-    liftRewrite (vMatch (List vals) pat env)+    liftRewrite (vMatch (ADTVal "list" (Prelude.map FValue vals)) pat env)
src/Funcons/Exceptions.hs view
@@ -13,14 +13,15 @@         | PartialOp String         | Internal String          | NoRule +        | NoMoreBranches         | SideCondFail String         | InsufficientInput Name         | InsufficientInputConsumed Name         | PatternMismatch String-        | StepOnValue+        | StepOnValue [Values]  showIException :: IException -> String-showIException (f0,f,ie) = "Internal Exception: " ++ show ie ++ " on " ++ showFuncons f +showIException (f0,f,ie) = "Internal Exception: " ++ show ie ++ " on \n" ++ showFuncons f0  instance Show IE where     show (SortErr err) = "dynamic sort check (" ++ err ++ ")"@@ -32,7 +33,8 @@     show (InsufficientInput nm) = "insufficient supply for " ++ unpack nm     show (InsufficientInputConsumed nm) = "insufficient input consumed for entity " ++ unpack nm     show (PartialOp str) = "partial operation"-    show StepOnValue = "attempting to step a value"+    show (NoMoreBranches) = "no more branches to try"+    show (StepOnValue v) = "attempting to step a value: " ++ showValuesSeq v  -- which exceptions stop a rule from executing so that the next one can be attempted? failsRule :: IException -> Bool@@ -40,7 +42,9 @@ failsRule (_,_,PatternMismatch _)   = True failsRule (_,_,SortErr  _)          = True failsRule (_,_,PartialOp  _)        = True-failsRule (_,_,StepOnValue)         = True+failsRule (_,_,StepOnValue _)       = True+failsRule (_,_,NoMoreBranches)      = True+failsRule (_,_,NoRule)              = True  failsRule _                         = False
+ src/Funcons/GLLParser.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE OverloadedStrings #-}++module Funcons.GLLParser where++import Funcons.Types+import GLL.Combinators hiding (many, some, Char, parse)++import Data.Char (isAlphaNum, isLower)+import Text.Regex.Applicative hiding ((<**>), optional)+import Data.Text (pack)+import Numeric++type Parser a = BNF Token a++fct_parse :: String -> Funcons+fct_parse = parser_a pFuncons++fvalue_parse :: String -> Funcons+fvalue_parse = FValue . fvalue_parse_ ++fvalue_parse_ :: String -> Values+fvalue_parse_ = parser_a pValues++parse :: Parser a -> String -> a+parse p str = case allParses p str of []    -> error "no parse"+                                      (a:_) -> a++parser_a :: Parser a -> String -> a+parser_a p string = case allParses p string of+  []    -> error "no parse"+  (f:_) -> f++allParses :: Parser a -> String -> [a]+allParses p string = GLL.Combinators.parseWithOptions [throwErrors] p +                        (Funcons.GLLParser.lexer string) ++fct_lexerSettings = emptyLanguage {+    lineComment = "//"+  , identifiers = lName+  , keywords    = fct_keywords+  , keychars    = fct_keychars+  }++lexer = GLL.Combinators.lexer fct_lexerSettings++fct_keywords = ["void", "depends", "forall", "type_abs"+               ,"typevar", "?", "*", "+", "|->", "=>"]+fct_keychars = "{}(),'\"[]|^&~"++lName = (:) <$> psym isLower <*> many (psym (\c -> isAlphaNum c || c == '-'))++data FSuffix  = SuffixComputesFrom Funcons+              | SuffixSeq SeqSortOp+              | SuffixSortUnion Funcons+              | SuffixSortInter Funcons+              | SuffixPower Funcons++pFuncons :: Parser Funcons+pFuncons = "FUNCONS" +  <:=  FSet               <$$> braces   (multipleSepBy pFuncons (keychar ','))+--  <||> FTuple             <$$> parens   (multipleSepBy pFuncons (keychar ','))+  <||> FApp "list"        <$$> brackets (multipleSepBy pFuncons (keychar ','))+  <||> FMap . concat      <$$> braces   (multipleSepBy1 pKeyPair (keychar ','))+  <||> FSortComputes      <$$  keyword "=>" <**> pFuncons+  <||> FSortComplement    <$$  keychar '~' <**> pFuncons+  <||> suffix_select      <$$> pFuncons <**> pFSuffix +  <||> suffix_select      <$$> parens pFuncons <**> pFSuffix +  <||> maybe_apply . pack <$$> id_lit <**> optional pFunconss+  <||> FValue             <$$> pValues+ where+    maybe_apply nm Nothing = FName nm+    maybe_apply nm (Just (Right args)) = FApp nm args+    maybe_apply nm (Just (Left arg)) =  FApp nm [arg]++    suffix_select f1 s = case s of +      SuffixComputesFrom f2 -> FSortComputesFrom f1 f2+      SuffixSeq op          -> FSortSeq f1 op+      SuffixSortUnion f2    -> FSortUnion f1 f2+      SuffixSortInter f2    -> FSortInter f1 f2+      SuffixPower f2        -> FSortPower f1 f2++    pFSuffix :: Parser FSuffix+    pFSuffix = "FSUFFIX" +      <:=>  SuffixComputesFrom  <$$   keyword "=>" <**> pFuncons+      <||>  SuffixSeq           <$$>  pOp+      <||>  SuffixSortUnion     <$$   keychar '|' <**> pFuncons+      <||>  SuffixSortInter     <$$   keychar '&' <**> pFuncons+      <||>  SuffixPower         <$$   keychar '^' <**> pFuncons+                          +pFunconss :: Parser (Either Funcons [Funcons])+pFunconss = "FUNCONS-SEQUENCE" +  <::=  Left  <$$> pFuncons+  <||>  Right . merge <$$> parens (multipleSepBy pFunconss (keychar ','))+  where merge = foldr op [] +          where op (Left f) acc = f:acc+                op (Right fs) acc = fs++acc++pFunconsSeq :: Parser [Funcons]+pFunconsSeq = "FUNCONS-SEQ" +  <:=> either (:[]) id <$$> pFunconss++pKeyPair :: Parser [Funcons]+pKeyPair = "KEYPAIR" <:=> +  (\x y -> [x,y]) <$$> pFuncons <** keyword "|->" <**> pFuncons++pOp :: Parser SeqSortOp+pOp = "OP" <:=> +  StarOp  <$$  keyword "*"+          <||> PlusOp <$$ keyword "+"+          <||> QuestionMarkOp <$$ keyword "?"++pValues :: Parser Values+pValues = "VALUES" +  <:=> Char      <$$> char_lit+  <||> string__  <$$> string_lit+  <||> mk_integers . toInteger <$$> int_lit +  <||> IEEE_Float_64 . fst . head . readFloat <$$> pRatioAsString+ where  pRatioAsString = "RATIOasSTRING" -- NOT OK, would parse "-2.-3"+          <:=> (\m l -> show m ++ "." ++ show l) <$$> int_lit <** keychar '.'+                                                 <**> int_lit++
− src/Funcons/Lexer.hs 
@@ -1,32 +0,0 @@-module Funcons.Lexer where--import Text.ParserCombinators.Parsec-import Text.ParserCombinators.Parsec.Language (emptyDef)-import qualified Text.ParserCombinators.Parsec.Token as P--lexer = P.makeTokenParser emptyDef  { P.identStart  = letter-                                    , P.identLetter = alphaNum <|> (char '-')-                                    , P.reservedNames = [ "id", "void", "newline", "depends", "forall", "type_abs", "typevar", "atom", "?", "*", "+"]-                                    , P.reservedOpNames = ["|->", "=>"]-                                    , P.commentLine = "//"-                                    }--types_keywords = ["chars", "strings", "integers","meta", "atoms", "bounded-integers", "computation-types", "empty-type", "unicode-characters", "maps", "types", "algebraic-datatypes", "bits", "ieee-floats", "lists", "sets", "multisets", "vectors", "naturals", "rationals", "thunks", "tuples", "ascii-characters", "values", "unknown"] --parens          = P.parens lexer -brackets        = P.brackets lexer-braces          = P.braces lexer-identifier      = P.identifier lexer-natural         = P.natural lexer-reserved        = P.reserved lexer-reservedOp      = P.reservedOp lexer-comma           = P.comma lexer-stringLiteral   = P.stringLiteral lexer-period          = P.dot lexer-commaSep        = P.commaSep lexer-commaSep1       = P.commaSep1 lexer-whiteSpace      = P.whiteSpace lexer-bar             = whiteSpace *> char '|' <* whiteSpace-doubleArrow     = whiteSpace *> reservedOp "=>" <* whiteSpace-barredArrow     = whiteSpace *> reservedOp "|->" <* whiteSpace-barSep2 p       = (:) <$> p <* bar <*> sepBy1 p bar
src/Funcons/MSOS.hs view
@@ -6,28 +6,35 @@     MSOS(..), Rewrite(..), liftRewrite, rewrite_rethrow, rewrite_throw, eval_catch, msos_throw,          EvalFunction(..), Strictness(..), StrictFuncon, PartiallyStrictFuncon,              NonStrictFuncon, ValueOp, NullaryFuncon, RewriteState(..),+            StepRes, toStepRes,         -- ** Entity-types         Output, readOuts,          Mutable,          Inherited, giveINH, -        Control, singleCTRL, +        Control, singleCTRL, giveCTRL,          Input,             -- ** IMSOS helpers-            applyFuncon, rewritten, rewriteTo, stepTo-                , compstep,-                norule, exception, sortErr, partialOp, internal, buildStep,+            applyFuncon, rewritten, rewriteTo, rewriteSeqTo, stepTo, stepSeqTo,rewrittens,+                compstep,+                norule, exception, sortErr, partialOp, internal, buildStep, sidecond,             -- *** Congruence rules             premiseStepApp, premiseStep, premiseEval,         -- ** Pattern Matching         SeqSortOp(..),                         rewriteRules, stepRules, evalRules, MSOSState(..), emptyMSOSState, emptyRewriteState, MSOSReader(..),RewriteReader(..),showIException, MSOSWriter(..), RewriteWriterr(..),     -- * Evaluation funcons TODO internal usage only (by Funcons.Tools)-        Rewritten(..), rewriteFuncons, evalFuncons, stepTrans, emptyINH, Interactive(..), SimIO(..),+        Rewritten(..), rewriteFuncons, rewriteFunconsWcount, evalFuncons+          , stepTrans, rewritesToValue, rewritesToValues+          , emptyDCTRL, emptyINH, Interactive(..), SimIO(..)+          , rewriteToValErr, count_delegation, optRefocus+          , evalStrictSequence, rewriteStrictSequence, evalSequence,     -- * Values-        showValues, showFuncons, +        showTypes, showSorts, showValues, showValuesSeq, showFuncons, showFunconsSeq,traceLib,     -- * Funcon libraries-    FunconLibrary, libUnions, libEmpty, libUnion, libFromList,-    evalctxt2exception, ctxt2exception,+    FunconLibrary, libUnions, libOverrides, libEmpty, libUnion, libOverride, libFromList,+    evalctxt2exception, ctxt2exception, fromSeqValOp, fromNullaryValOp, fromValOp,+    -- * Counters+    displayCounters, counterKeys, ppCounters,     )where  @@ -36,19 +43,53 @@ import Funcons.Printer import Funcons.Exceptions import Funcons.Simulation+import qualified Funcons.Operations as VAL +import Control.Applicative import Control.Arrow ((***)) import Control.Monad.Writer-import Data.Maybe (isJust, isNothing)-import Data.List (foldl')+import Data.Maybe (isJust, isNothing, fromJust)+import Data.List (foldl', intercalate) import Data.Text (unpack)  import qualified Data.Map as M +import System.IO.Unsafe+--trace p b = unsafePerformIO (putStrLn p >> return b) +trace p b = b+traceLib :: FunconLibrary -> FunconLibrary+traceLib lib = unsafePerformIO +  (putStrLn (unlines (map unpack (M.keys lib))) >> return lib)++ --------------------------------------------------------------------- -- | A funcon library maps funcon names to their evaluation functions. type FunconLibrary = M.Map Name EvalFunction +fromValOp = fromAbsValOp False+fromSeqValOp = fromAbsValOp True+fromAbsValOp :: Bool -> ([Funcons] -> Funcons) -> ([OpExpr Funcons] -> OpExpr Funcons) -> EvalFunction+fromAbsValOp seqRes cons mkExpr = ValueOp op+ where op vs = report f seqRes (VAL.eval (mkExpr (map ValExpr vs))) +        where f = cons (map FValue vs)+fromNullaryValOp :: ([Funcons] -> Funcons) -> ([OpExpr Funcons] -> OpExpr Funcons) -> EvalFunction+fromNullaryValOp cons mkExpr = NullaryFuncon op+  where op = report (cons []) False (VAL.eval (mkExpr []))++report f seqRes res = case res of+  Error _ (VAL.SortErr str)   -> sortErr f str+  Error _ (DomErr str)        -> rewritten none__ +  Error _ (ArityErr str)      -> sortErr f str+  Error _ (ProjErr str)       -> sortErr f str+  Error _ (Normal (FValue v)) -> rewritten' v+  Error _ (Normal t)          -> rewriteFuncons t+  Success (FValue v)          -> rewritten' v+  Success t                   -> rewriteFuncons t+  where rewritten' v | seqRes, ADTVal "list" fs <- v, +                        let mvs = map project fs, all isJust mvs+                        = rewrittens (map fromJust mvs)+                     | otherwise = rewritten v+  -- | -- Evaluation functions capture the operational behaviour of a funcon. -- Evaluation functions come in multiple flavours, each with a different@@ -61,7 +102,7 @@                     -- | Strict funcons whose arguments are evaluated.                     | StrictFuncon StrictFuncon                     -- | Funcons for which /some/ arguments are evaluated.-                    | PartiallyStrictFuncon [Strictness] NonStrictFuncon+                    | PartiallyStrictFuncon [Strictness] Strictness NonStrictFuncon                     -- | Synonym for 'StrictFuncon', for value operations.                     | ValueOp ValueOp                     -- | Funcons without any arguments.@@ -86,12 +127,16 @@ -- computational steps. data Rewritten =      -- | Fully rewritten to a value.-    ValTerm Values +    ValTerm [Values]     -- | Fully rewritten to a term and the step required to continue evaluation.-    | CompTerm Funcons (MSOS Funcons)+    | CompTerm Funcons (MSOS StepRes) +-- | A single step on a funcon term produces either a funcon term +-- or a (possibly empty or unary) sequence of values+type StepRes = Either Funcons [Values]+ instance Show Rewritten where-    show (ValTerm v) = showValues v+    show (ValTerm vs) = showValuesSeq vs     show (CompTerm _ _) = "<step>"  -- | Creates an empty 'FunconLibrary'.@@ -103,11 +148,19 @@ libUnion = M.unionWithKey op  where op k x _ = error ("duplicate funcon name: " ++ unpack k) +-- | Right-based union of 'FunconLibrary's+libOverride :: FunconLibrary -> FunconLibrary -> FunconLibrary +libOverride = flip M.union + -- | Unites a list of 'FunconLibrary's. libUnions :: [FunconLibrary] -> FunconLibrary libUnions = foldl' libUnion libEmpty  where op _ _ = error ("duplicate funcon name") +-- | Right-based union of list of 'FunconLibrary's+libOverrides :: [FunconLibrary] -> FunconLibrary+libOverrides = M.unions . reverse+ -- | Creates a 'FunconLibrary' from a list. libFromList :: [(Name, EvalFunction)] -> FunconLibrary libFromList = M.fromList@@ -124,7 +177,7 @@ --------------------------------------------------------------------------- data RewriteReader = RewriteReader                       { funconlib  :: FunconLibrary    -                    , ty_env     :: TypeEnv, run_opts :: RunOptions+                    , ty_env     :: TypeRelation, run_opts :: RunOptions                     , global_fct :: Funcons, local_fct :: Funcons } data RewriteState = RewriteState {  } emptyRewriteState = RewriteState @@ -181,28 +234,33 @@ rewrite_rethrow ie = Rewrite $ \ctxt st -> (Left ie, st, mempty)  rewrite_throw :: IE -> Rewrite a-rewrite_throw ie = Rewrite $ \ctxt st -> -    (Left (global_fct ctxt, local_fct ctxt, ie), st, mempty)+rewrite_throw ie = Rewrite $ \ctxt st -> (Left (evalctxt2exception ie ctxt), st, mempty)  evalctxt2exception :: IE -> RewriteReader -> IException evalctxt2exception ie ctxt = (global_fct ctxt, local_fct ctxt, ie) -ctxt2exception :: IE -> MSOSReader -> IException+ctxt2exception :: IE -> MSOSReader m -> IException ctxt2exception ie ctxt =      (global_fct (ereader ctxt), local_fct (ereader ctxt), ie)  -rewriteRules :: Funcons -> [Rewrite Rewritten] -> Rewrite Rewritten-rewriteRules f [] = norule f -rewriteRules f (t1:ts) = Rewrite $ \ctxt st ->  +rewriteRules :: [Rewrite Rewritten] -> Rewrite Rewritten+rewriteRules [] = rewrite_throw NoMoreBranches+rewriteRules (t1:ts) = Rewrite $ \ctxt st ->       let (rw_res, st', rw_cs) = runRewrite t1 ctxt st     in case rw_res of         Left ie| failsRule ie -> -- resets state -                                 runRewrite (rewriteRules f ts) ctxt st +                                 trace (showIException ie) $ runRewrite (do+                                  count_backtrack_in+                                  addToRCounter (counters rw_cs)+                                  rewriteRules ts) ctxt st          _                     -> (rw_res, st', rw_cs)  ----------------------------------------------------------------------------data MSOSReader = MSOSReader { ereader :: RewriteReader, inh_entities :: Inherited}+data MSOSReader m = MSOSReader{ ereader :: RewriteReader +                              , inh_entities :: Inherited+                              , dctrl_entities :: DownControl+                              , def_fread :: Name -> m Funcons} data MSOSWriter = MSOSWriter { ctrl_entities :: Control, out_entities :: Output                              , ewriter :: RewriteWriterr } data MSOSState m = MSOSState { inp_es :: Input m, mut_entities :: Mutable@@ -212,7 +270,7 @@  -- | Monadic type for the propagation of semantic entities and meta-information -- on the evaluation of funcons. The meta-information includes a library --- of funcons (see 'FunconLibrary'), a typing environment (see 'TypeEnv'), +-- of funcons (see 'FunconLibrary'), a typing environment (see 'TypeRelation'),  -- runtime options, etc. -- -- The semantic entities are divided into five classes:@@ -234,7 +292,7 @@ -- This enables modular access to the entities. newtype MSOS a = MSOS { runMSOS ::                          forall m. Interactive m => -                        (MSOSReader -> MSOSState m +                        (MSOSReader m -> MSOSState m                          -> m (Either IException a, MSOSState m, MSOSWriter)) }  instance Applicative MSOS where@@ -264,13 +322,18 @@ -- | A map storing the values of /mutable/ entities. type Mutable      = M.Map Name Values -stepRules :: [MSOS Funcons] -> MSOS Funcons -stepRules [] = msos_throw NoRule-stepRules (t1:ts) = MSOS $ \ctxt mut -> do +stepRules = stepARules NoMoreBranches count_backtrack_in++stepARules :: IE -> Rewrite () -> [MSOS StepRes] -> MSOS StepRes+stepARules exc _ [] = msos_throw exc+stepARules exc counter (t1:ts) = MSOS $ \ctxt mut -> do      (e_ie_a, mut', wr) <- runMSOS t1 ctxt mut      case e_ie_a of         Left ie | failsRule ie -> -- resets input & read/write entities-                                  runMSOS (stepRules ts) ctxt mut+                                  trace (showIException ie) $ runMSOS (do+                                    liftRewrite counter+                                    addToCounter (counters (ewriter wr))+                                    stepARules exc counter ts) ctxt mut         _                      -> return (e_ie_a, mut', wr)  -- | Function 'evalRules' implements a backtracking procedure.@@ -290,14 +353,17 @@ -- -- When no rules are successfully executed to completetion a  -- 'no rule exception' is thrown.-evalRules :: [Rewrite Rewritten] -> [MSOS Funcons] -> Rewrite Rewritten-evalRules [] msoss = buildStep (stepRules msoss)+evalRules :: [Rewrite Rewritten] -> [MSOS StepRes] -> Rewrite Rewritten+evalRules [] msoss = buildStep (stepARules NoRule count_backtrack_out msoss) evalRules ((Rewrite rw_rules):rest) msoss = Rewrite $ \ctxt st -> -    let (rw_res, st', cs) = rw_rules ctxt st+    let (rw_res, st', wo) = rw_rules ctxt st     in case rw_res of         Left ie | failsRule ie  -> --resets counters and state -                                    runRewrite (evalRules rest msoss) ctxt st-        _                       -> (rw_res, st', cs)+                                   trace (showIException ie) $ runRewrite (do+                                      count_backtrack_out+                                      addToRCounter (counters wo)+                                      evalRules rest msoss) ctxt st+        _                       -> (rw_res, st', wo)  msos_throw :: IE -> MSOS b msos_throw = liftRewrite . rewrite_throw @@ -310,13 +376,13 @@ giveINH :: MSOS Inherited giveINH = MSOS $ \ctxt mut -> return (Right (inh_entities ctxt), mut, mempty) +giveCTRL :: MSOS DownControl +giveCTRL = MSOS $ \ctxt mut -> return (Right (dctrl_entities ctxt), mut, mempty)+ doRefocus :: MSOS Bool doRefocus = MSOS $ \ctxt mut ->      return (Right $ do_refocus (run_opts (ereader ctxt)), mut, mempty) -modifyCTXT :: (MSOSReader -> MSOSReader) -> MSOS a -> MSOS a-modifyCTXT mod (MSOS f) = MSOS (\ctxt mut -> f (mod ctxt) mut)- modifyRewriteCTXT :: (RewriteReader -> RewriteReader) -> Rewrite a -> Rewrite a modifyRewriteCTXT mod (Rewrite f) = Rewrite (f . mod) -----------------@@ -330,7 +396,11 @@ ---------- -- | a map storing the values of /control/ entities. type Control = M.Map Name (Maybe Values)+type DownControl = M.Map Name (Maybe Values) +emptyDCTRL :: DownControl+emptyDCTRL = M.empty+ emptyCTRL :: Control emptyCTRL = M.empty @@ -359,40 +429,57 @@                             , mut1, wr1 { out_entities = mempty})) ----------- -- | A map storing the values of /input/ entities.-type Input m = M.Map Name ([[Values]], Maybe (m Values))+type Input m = M.Map Name ([[Values]], Maybe (m Funcons))  -------------- steps, rewrites, restarts, refocus, delegations-data Counters = Counters !Int !Int !Int !Int !Int +-- steps, rewrites, restarts, refocus, delegations, backtracking (outer/inner)+data Counters = Counters !Int !Int !Int !Int !Int !Int !Int !Int   instance Monoid Counters where-    mempty = Counters 0 0 0 0 0-    (Counters x1 x2 x3 x4 x5) `mappend` (Counters y1 y2 y3 y4 y5) = -        Counters (x1+y1) (x2+y2) (x3+y3) (x4+y4) (x5+y5)+    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 :: Int -> Int -> Int -> Int -> Int -> MSOSWriter -emptyCounters x1 x2 x3 x4 x5 = -    mempty { ewriter = mempty {counters = Counters x1 x2 x3 x4 x5 }}+emptyCounters x1 x2 x3 x4 x5 x6 x7 x8 = +    mempty { ewriter = mempty {counters = Counters x1 x2 x3 x4 x5 x6 x7 x8}} +addToCounter :: Counters -> MSOS ()+addToCounter cs = MSOS $ \_ mut -> return (Right(), mut, mempty { ewriter = mempty { counters = cs } })++addToRCounter :: Counters -> Rewrite () +addToRCounter cs = Rewrite $ \_ mut -> (Right(), mut, mempty { counters = cs })+ count_step :: MSOS ()-count_step = MSOS $ \_ mut -> return (Right (), mut, emptyCounters 1 0 0 0 0)+count_step = MSOS $ \_ mut -> return (Right (), mut, emptyCounters 1 0 0 0 0 0 0 0)  count_delegation :: MSOS ()-count_delegation = MSOS $ \_ mut -> return (Right (), mut, emptyCounters 0 0 0 0 1)+count_delegation = MSOS $ \_ mut -> return (Right (), mut, emptyCounters 0 0 0 0 0 1 0 0) -count_refocus = MSOS $ \_ mut -> return (Right (), mut, emptyCounters 0 0 0 1 0)+count_refocus = MSOS $ \_ mut -> return (Right (), mut, emptyCounters 0 0 0 0 1 0 0 0)  count_restart :: MSOS ()-count_restart = MSOS $ \_ mut -> return (Right (), mut, emptyCounters 0 0 1 0 0)+count_restart = MSOS $ \_ mut -> return (Right (), mut, emptyCounters 0 0 0 1 0 0 0 0)  count_rewrite :: Rewrite ()-count_rewrite = Rewrite $ \_ st -> (Right (), st, mempty { counters = Counters 0 1 0 0 0 })+count_rewrite = Rewrite $ \_ st -> (Right (), st, mempty { counters = Counters 0 1 0 0 0 0 0 0}) -instance Show Counters where-    show (Counters steps rewrites restarts refocus delegations) = -        "number of (restarts, rewrites, steps, refocus, premises): " ++ -            show (restarts, rewrites, steps, refocus, delegations)+count_rewrite_attempt :: Rewrite ()+count_rewrite_attempt = Rewrite $ \_ st -> (Right (), st, mempty { counters = Counters 0 0 1 0 0 0 0 0}) +count_backtrack_out :: Rewrite ()+count_backtrack_out = Rewrite $ \_ st -> (Right (), st, mempty { counters = Counters 0 0 0 0 0 0 1 0 })++count_backtrack_in :: Rewrite ()+count_backtrack_in = Rewrite $ \_ st -> (Right (), st, mempty { counters = Counters 0 0 0 0 0 0 0 1 })++ppCounters cs =+ "number of (" ++ counterKeys ++ "): (" ++ displayCounters cs ++ ")"++counterKeys = "restarts,rewrites,(attempts),steps,refocus,premises,backtracking(outer),backtracking(inner)"+displayCounters (Counters steps rewrites rattempts restarts refocus delegations bout bin) = +  intercalate "," $ +    map show [restarts, rewrites, rattempts, steps, refocus, delegations, bout, bin]+ -- | Yields an error signaling that no rule is applicable. -- The funcon term argument may be used to provide a useful error message. norule :: Funcons -> Rewrite a@@ -419,48 +506,68 @@ internal :: String -> Rewrite a internal str = rewrite_throw (Internal str) +sidecond :: String -> Rewrite a+sidecond str = rewrite_throw (SideCondFail str) -buildStep :: MSOS Funcons -> Rewrite Rewritten +buildStep :: MSOS StepRes -> Rewrite Rewritten  buildStep = buildStepCounter (return ()) -- does not count -buildStepCount :: MSOS Funcons -> Rewrite Rewritten+buildStepCount :: MSOS StepRes -> Rewrite Rewritten buildStepCount = buildStepCounter count_delegation -buildStepCounter :: MSOS () -> MSOS Funcons -> Rewrite Rewritten +buildStepCounter :: MSOS () -> MSOS StepRes -> Rewrite Rewritten  buildStepCounter counter mf = compstep (counter >> mf) -optRefocus :: MSOS Funcons -> MSOS Funcons+optRefocus :: MSOS StepRes -> MSOS StepRes optRefocus stepper = doRefocus >>= \case                         True    -> refocus stepper                          False   -> stepper  -refocus :: MSOS Funcons -> MSOS Funcons+refocus :: MSOS StepRes -> MSOS StepRes refocus stepper -- stop refocussing when a signal has been raised                 = count_refocus >> if_violates_refocus stepper return continue-    where continue f | isVal f = return f-                     | otherwise = refocus (evalFuncons f)+    where continue = \case+            Right vs  -> return (Right vs)+            Left f    -> +              liftRewrite (rewriteFuncons f) >>= \case+                ValTerm [v] -> return (Right [v])+                ValTerm vs  -> return (Left f) -- undo rewrites and accept last step+                res         -> refocus $ stepRewritten res -stepRewritten :: Rewritten -> MSOS Funcons-stepRewritten (ValTerm v) = return (FValue v)+stepRewritten :: Rewritten -> MSOS StepRes +stepRewritten (ValTerm vs) = return (Right vs) stepRewritten (CompTerm _ step) = count_step >> step  -- | Returns a value as a fully rewritten term.  rewritten :: Values -> Rewrite Rewritten-rewritten = return . ValTerm+rewritten = return . ValTerm . (:[]) +rewrittens :: [Values] -> Rewrite Rewritten+rewrittens = return . ValTerm+ -- | Yield a funcon term as the result of a syntactic rewrite. -- This function must be used instead of @return@. -- The given term is fully rewritten. rewriteTo :: Funcons -> Rewrite Rewritten -- only rewrites, no possible signal rewriteTo f = count_rewrite >> rewriteFuncons f +-- | Yield a sequence of funcon terms as the result of a rewrite.+-- This is only valid when all terms rewrite to a value+rewriteSeqTo :: [Funcons] -> Rewrite Rewritten+rewriteSeqTo fs = count_rewrite >> (ValTerm <$> rewriteStrictSequence fs)+ -- | Yield a funcon term as the result of an 'MSOS' computation. -- This function must be used instead of @return@. -stepTo :: Funcons -> MSOS Funcons-stepTo f = return f+stepTo :: Funcons -> MSOS StepRes +stepTo = return . Left -if_abruptly_terminates :: Bool -> MSOS Funcons -> (Funcons -> MSOS Funcons)-                            -> (Funcons -> MSOS Funcons) -> MSOS Funcons+-- | Yield a sequence of funcon terms as the result of a computation.+-- This is only valid when all terms rewrite to a value+stepSeqTo :: [Funcons] -> MSOS StepRes+stepSeqTo fs = Right <$> liftRewrite (rewriteStrictSequence fs)++if_abruptly_terminates :: Bool -> MSOS StepRes -> (StepRes -> MSOS StepRes)+                            -> (StepRes -> MSOS StepRes) -> MSOS StepRes if_abruptly_terminates care (MSOS fstep) abr no_abr = MSOS $ \ctxt mut ->     fstep ctxt mut >>= \case         (Right f', mut', wr') ->@@ -471,14 +578,17 @@                   return (e_f'', mut'', wr' <> wr'')         norule_res -> return norule_res -if_violates_refocus :: MSOS Funcons -> (Funcons -> MSOS Funcons)-                            -> (Funcons -> MSOS Funcons) -> MSOS Funcons+-- TODO is input test accurate? +-- TODO We should also find changes to mutable entities+if_violates_refocus :: MSOS StepRes -> (StepRes -> MSOS StepRes)+                            -> (StepRes -> MSOS StepRes) -> MSOS StepRes if_violates_refocus (MSOS fstep) viol no_viol = MSOS $ \ctxt mut ->     fstep ctxt mut >>= \case         (Right f', mut', wr') ->             let violates = any isJust (ctrl_entities wr')                             || any (not . null) (out_entities wr')                             || any (isNothing . snd) (inp_es mut')+--                            || any isJust (dctrl_entities ctxt)                 MSOS fstep | violates    = viol f'                            | otherwise   = no_viol f'             in do (e_f'', mut'', wr'') <- fstep ctxt mut'@@ -486,84 +596,156 @@         norule_res -> return norule_res  -- | Execute a premise as either a rewrite or a step.--- Depending on whether rewrites were performed or a step was performed+-- Depending on whether only rewrites are necessary to yield a value,+-- or whether a computational step is necessary, -- a different continuation is applied (first and second argument). -- Example usage: -- -- @ -- stepScope :: NonStrictFuncon --strict in first argument -- stepScope [FValue (Map e1), x] = premiseEval x rule1 step1 ---  where   rewrite1 v  = rewritten v+--  where   rule1 v  = rewritten v --          step1 stepX = do    --              Map e0  <- getInh "environment" --              x'      <- withInh "environment" (Map (union e1 e0)) stepX --              stepTo (scope_ [FValue e1, x']) -- @-premiseEval :: (Values -> Rewrite Rewritten) -> (MSOS Funcons -> MSOS Funcons) -> +premiseEval :: ([Values] -> Rewrite Rewritten) -> (MSOS StepRes -> MSOS StepRes) ->                      Funcons -> Rewrite Rewritten premiseEval vapp fapp f = rewriteFuncons f >>= \case-    ValTerm v       -> vapp v+    ValTerm vs      -> vapp vs     CompTerm _ step -> buildStepCount (optRefocus (fapp step)) -premiseCont :: (Funcons -> Funcons) -> Funcons -> MSOS Funcons -premiseCont app f = liftRewrite (rewriteFuncons f) >>= \case-    ValTerm v       -> msos_throw StepOnValue-    CompTerm _ step -> app <$> (count_delegation >> optRefocus step)--premiseStepApp :: (Funcons -> Funcons) -> Funcons -> MSOS Funcons-premiseStepApp app f = premiseCont app f- -- | Execute a computational step as a /premise/. -- The result of the step is the returned funcon term. -premiseStep :: Funcons -> MSOS Funcons-premiseStep = premiseStepApp id+premiseStepApp :: (StepRes -> StepRes) -> Funcons -> MSOS StepRes+premiseStepApp app f = liftRewrite (rewriteFuncons f) >>= \case+    ValTerm vs      -> msos_throw (StepOnValue vs)+    CompTerm _ step -> app <$> (count_delegation >> optRefocus step) +premiseStep :: Funcons -> MSOS StepRes +premiseStep = premiseStepApp id + ----- main `step` function-evalFuncons :: Funcons -> MSOS Funcons+evalFuncons :: Funcons -> MSOS StepRes  evalFuncons f = liftRewrite (rewriteFuncons f) >>= stepRewritten +rewritesToValue :: Funcons -> Rewrite Values+rewritesToValue f = do+  rewriteFunconsWcount f >>= \case+    ValTerm [v]   -> return v+    _             -> rewriteToValErr++rewritesToValues :: Funcons -> Rewrite [Values]+rewritesToValues f = do+  rewriteFunconsWcount f >>= \case+    ValTerm vs  -> return vs+    _           -> rewriteToValErr++rewriteToValErr = rewrite_throw $ +  SideCondFail "side-condition/entity-value/annotation evaluation requires step"++rewriteFunconsWcount :: Funcons -> Rewrite Rewritten+rewriteFunconsWcount f = count_rewrite_attempt >> rewriteFuncons f+ rewriteFuncons :: Funcons -> Rewrite Rewritten -rewriteFuncons f = modifyRewriteCTXT (\ctxt -> ctxt {local_fct = f}) (rewriteFuncons' f)+rewriteFuncons f = modifyRewriteCTXT (\ctxt -> ctxt{local_fct = f}) (rewriteFuncons' f)  where-    rewriteFuncons' (FValue v)   = return (ValTerm v) -    rewriteFuncons' (FTuple fs)  = let fmops = tupleTypeTemplate fs -                                in if any (isJust . snd) fmops-                                    then rewritten . typeVal =<< evalTupleType fmops-                                    else evalStrictSequence fs safe_tuple_val FTuple-    rewriteFuncons' (FList fs)   = evalStrictSequence fs List FList-    rewriteFuncons' (FSet fs)    = evalStrictSequence fs setval_ FSet-    rewriteFuncons' (FMap fs)    = evalStrictSequence fs mapval_ FMap-    rewriteFuncons' f@(FSortSeq s1 op)     =-        internal ("naked sequence-sort appearing outside of tuple-notation: " ++ showFuncons f)+    rewriteFuncons' (FValue v)   = return (ValTerm [v]) +{-    rewriteFuncons' (FTuple fs)  = +      let fmops = tupleTypeTemplate fs +      in if any (isJust . snd) fmops+          -- sequence contains a sequence-operator, thus is a sequence of sorts  +          then rewritten . typeVal =<< evalTupleType fmops+          -- regular sequence +          else evalStrictSequence fs (rewritten . safe_tuple_val) FTuple+-}+--    rewriteFuncons' (FList fs)   = evalStrictSequence fs (rewritten . List) FList+    rewriteFuncons' (FSet fs)    = evalStrictSequence fs (rewritten . setval_) FSet+    rewriteFuncons' (FMap fs)    = evalStrictSequence fs (rewritten . mapval_) FMap+    rewriteFuncons' f@(FSortPower s1 fn) = case (s1,fn) of +      (FValue mty@(ComputationType _), FValue v) +        | Nat n <- upcastNaturals v -> +                  rewrittens (replicate (fromInteger n) (ComputationType (Type (downcastValueType mty))))+      (FValue mty, _) -> rewriteFuncons fn >>= \case +            ValTerm [v] -> rewriteFuncons $ FSortPower s1 (FValue v)+            ValTerm _   -> sortErr f "second operand of ^ cannot compute a sequence"+            CompTerm _ mf -> flattenApplyWithExc ie (FSortPower s1) mf+                where ie = SortErr "^_ multiadic argument" +      _ -> rewriteFuncons s1 >>= \case+            ValTerm [v] -> rewriteFuncons $ FSortPower (FValue v) fn+            ValTerm _   -> sortErr f "first operand of ^ cannot compute a sequence"+            CompTerm _ mf -> flattenApplyWithExc ie (flip FSortPower fn) mf+              where ie = SortErr "_^ multiadic argument"+    rewriteFuncons' f@(FSortSeq s1 op)     = case s1 of +      (FValue (ComputationType (Type ty))) -> rewritten $ ComputationType $ Type $ AnnotatedType ty op+      (FValue _) -> sortErr (FSortSeq s1 op) "sort-sequence operator not on type"+      _ -> rewriteFuncons s1 >>= \case+            ValTerm [v1] -> rewriteFuncons $ FSortSeq (FValue v1) op+            ValTerm vs   -> sortErr (FSortSeq s1 op) "operand of sort-sequence operator cannot compute a sequence"+            CompTerm _ mf -> flattenApplyWithExc ie (flip FSortSeq op) mf+              where ie = SortErr "sort-sequence operator, multiadic argument"     rewriteFuncons' (FSortComputes f1) = case f1 of         (FValue (ComputationType (Type ty))) -> rewritten $ ComputationType $ ComputesType ty         (FValue _) -> sortErr (FSortComputes f1) "=> not applied to a type"         _ -> rewriteFuncons f1 >>= \case-                ValTerm v1 -> rewriteFuncons $ FSortComputes (FValue v1)-                CompTerm _ mf    -> compstep (FSortComputes <$> mf)+                ValTerm [v1] -> rewriteFuncons $ FSortComputes (FValue v1)+                ValTerm vs   -> sortErr (FSortComputes f1) "operand of => cannot compute a sequence"+                CompTerm _ mf    -> flattenApplyWithExc ie FSortComputes mf+                  where ie = SortErr "=>_ multiadic argument"     rewriteFuncons' (FSortComputesFrom f1 f2) = case (f1,f2) of         (FValue (ComputationType (Type ty1)),FValue (ComputationType (Type ty2)))              -> rewritten $ ComputationType (ComputesFromType ty1 ty2)         (FValue _, FValue _) -> sortErr (FSortComputesFrom f1 f2) "=> not applied to types"         (FValue (ComputationType (Type ty1)),_)              -> rewriteFuncons f2 >>= \case-                ValTerm v2 -> rewriteFuncons $ FSortComputesFrom f1 (FValue v2)-                CompTerm _ mf    -> compstep (FSortComputesFrom f1 <$> mf)+                ValTerm [v2] -> rewriteFuncons $ FSortComputesFrom f1 (FValue v2)+                ValTerm _ -> sortErr (FSortComputesFrom f1 f2) "second operand of => cannot compute a sequence"+                CompTerm _ mf    -> flattenApplyWithExc ie (FSortComputesFrom f1) mf+                  where ie = SortErr "_=>_ multiadic operand (2)"         (_,_)              -> rewriteFuncons f1 >>= \case-                ValTerm v1 -> rewriteFuncons $ FSortComputesFrom (FValue v1) f2-                CompTerm _ mf    -> compstep (flip FSortComputesFrom f2 <$> mf)+                ValTerm [v1] -> rewriteFuncons $ FSortComputesFrom (FValue v1) f2+                ValTerm _ -> sortErr (FSortComputesFrom f1 f2) "_=>_ multiadic operand (1)"+                CompTerm _ mf    -> flattenApplyWithExc ie (flip FSortComputesFrom f2) mf+                  where ie = SortErr "_=>_ multiadic operand (1)"     rewriteFuncons' (FSortUnion s1 s2)   = case (s1, s2) of         (FValue (ComputationType (Type t1))             , FValue (ComputationType (Type t2))) -> rewritten $ typeVal $ Union t1 t2         (FValue _, FValue _) -> sortErr (FSortUnion s1 s2) "sort-union not applied to two sorts"-        (FValue v1, _) -> do   rewriteFuncons s2 >>= \case-                                ValTerm v2 -> rewriteFuncons $ FSortUnion s1 (FValue v2)-                                CompTerm _ mf -> compstep (FSortUnion s1 <$> mf)+        (FValue v1, _) -> rewriteFuncons s2 >>= \case+            ValTerm [v2] -> rewriteFuncons $ FSortUnion s1 (FValue v2)+            ValTerm _ -> sortErr (FSortUnion s1 s2) "sort-union multiadic argument (2)"+            CompTerm _ mf -> flattenApplyWithExc ie (FSortUnion s1) mf+              where ie = SortErr "sort-union multiadic argument (2)"+        _ -> rewriteFuncons s1 >>= \case+                ValTerm [v] -> rewriteFuncons $ FSortUnion (FValue v) s2+                ValTerm _ -> sortErr (FSortUnion s1 s2) "sort-union multiadic argument (1)"+                CompTerm _ mf   -> flattenApplyWithExc ie (flip FSortUnion s2) mf+                  where ie = SortErr "sort-union multiadic argument (1)"+    rewriteFuncons' (FSortInter s1 s2)   = case (s1, s2) of+        (FValue (ComputationType (Type t1))+            , FValue (ComputationType (Type t2))) -> rewritten $ typeVal $ Intersection t1 t2+        (FValue _, FValue _) -> sortErr (FSortInter s1 s2) "sort-intersection not applied to two sorts"+        (FValue v1, _) -> rewriteFuncons s2 >>= \case+            ValTerm [v2] -> rewriteFuncons $ FSortInter s1 (FValue v2)+            ValTerm _ -> sortErr (FSortInter s1 s2) "sort-intersection multiadic argument (2)" +            CompTerm _ mf -> flattenApplyWithExc ie (FSortInter s1) mf+              where ie = SortErr "sort-intersection multiadic argument (2)"         _ -> do rewriteFuncons s1 >>= \case-                    ValTerm v -> rewriteFuncons $ FSortUnion (FValue v) s2-                    CompTerm _ mf   -> compstep (flip FSortUnion s2 <$> mf)-    rewriteFuncons' (FName nm)     = +                    ValTerm [v1] -> rewriteFuncons $ FSortInter (FValue v1) s2+                    ValTerm _ -> sortErr (FSortInter s1 s2) "sort-intersection multiadic argument (1)" +                    CompTerm _ mf   -> flattenApplyWithExc ie (flip FSortInter s2) mf+                      where ie = SortErr "sort-intersection multiadic argument (1)"+    rewriteFuncons' (FSortComplement s1) = case s1 of +      FValue (ComputationType (Type t1)) -> rewritten $ typeVal $ Complement t1+      FValue _ -> sortErr (FSortComplement s1) "sort-complement not applied to a sort" +      _ -> do rewriteFuncons s1 >>= \case+                ValTerm [v] -> rewriteFuncons $ FSortComplement (FValue v)+                ValTerm vs -> sortErr (FSortComplement s1) "sort-complement multiadic argument"+                CompTerm _ mf -> flattenApplyWithExc ie FSortComplement mf+                  where ie = SortErr "sort-complement multiadic argument"+    rewriteFuncons' (FName nm) =          do  mystepf <- lookupFuncon nm              case mystepf of                  NullaryFuncon mystep -> mystep@@ -571,39 +753,42 @@     rewriteFuncons' (FApp nm arg)    =          do  mystepf <- lookupFuncon nm             case mystepf of -                NullaryFuncon _     -> exception (FApp nm arg) ("nullary funcon " ++ unpack nm ++ " applied to arguments")-                ValueOp mystep      -> rewriteFuncons arg >>= -                                        \case ValTerm v -> mystep (tuple_unval v)-                                              CompTerm _ mf -> compstep (FApp nm <$> mf)-                StrictFuncon mystep -> rewriteFuncons arg >>=-                                        \case ValTerm v -> mystep (tuple_unval v)-                                              CompTerm _ mf -> compstep (FApp nm <$> mf)-                NonStrictFuncon mystep   -> case arg of-                                        FTuple fs -> mystep fs-                                        _ -> exception (FApp nm arg) ("lazy funcon " ++ unpack nm ++ " not applied to a tuple of arguments")-                PartiallyStrictFuncon strns mystep -> case arg of -                    FTuple fs -> evalSequence strns fs mystep (applyFuncon nm)-                    _ -> exception (FApp nm arg) ("partially lazy funcon " ++ unpack nm ++ " not applied to a tuple of arguments")+                NullaryFuncon _     -> exception (FApp nm arg) ("nullary funcon " ++ unpack nm ++ " applied to arguments: " ++ (showFunconsSeq arg))+                ValueOp mystep      -> evalStrictSequence arg mystep (applyFuncon nm)+                StrictFuncon mystep -> evalStrictSequence arg mystep (applyFuncon nm)+                NonStrictFuncon mystep -> mystep arg+                PartiallyStrictFuncon strns strn mystep -> +                  evalSequence (strns ++ repeat strn) arg mystep (applyFuncon nm) ---OPT: replace by specialised veriant of evalSequence-evalStrictSequence :: [Funcons] -> ([Values] -> Values) -> ([Funcons] -> Funcons) -> Rewrite Rewritten+rewriteStrictSequence :: [Funcons] -> Rewrite [Values] +rewriteStrictSequence fs = case rest of +  []      -> return (map downcastValue vs)+  (x:xs)  -> rewriteFuncons x >>= \case +    ValTerm vs'    -> rewriteStrictSequence (vs++map FValue vs'++xs)+    CompTerm f0 mf -> internal ("step on sequence of computations: " ++ show fs)+  where (vs, rest) = span (not . hasStep) fs++--OPT: replace by specialised variant of evalSequence+evalStrictSequence :: [Funcons] -> ([Values] -> Rewrite Rewritten) -> ([Funcons] -> Funcons) -> Rewrite Rewritten evalStrictSequence args cont cons =      evalSequence (replicate (length args) Strict) args -        (return . ValTerm . cont . map downcastValue) cons+        (cont . map downcastValue) cons  evalSequence :: [Strictness] -> [Funcons] ->      ([Funcons] -> Rewrite Rewritten) -> ([Funcons] -> Funcons) -> Rewrite Rewritten evalSequence strns args cont cons =      uncurry evalSeqAux $ map snd *** id $ span isDone (zip strns args)- where  evalSeqAux :: [Funcons] -> [(Strictness, Funcons)] -> Rewrite Rewritten+ where  unmatched = drop (length strns) args+        evalSeqAux :: [Funcons] -> [(Strictness, Funcons)] -> Rewrite Rewritten         evalSeqAux vs [] = cont vs         evalSeqAux vs ((_,f):fs) = premiseEval valueCont funconCont f-         where  valueCont v = do +         where  valueCont vs' = do                      count_rewrite-                    evalSeqAux (vs++(FValue v:map snd othervs)) otherfs+                    evalSeqAux (vs++(map FValue vs' ++ map snd othervs)) otherfs                  where (othervs, otherfs) = span isDone fs-                funconCont stepf = do   f' <- stepf -                                        stepTo (cons (vs++[f']++map snd fs))+                funconCont stepf = stepf >>= \case  +                  Left f' -> stepTo (cons (vs++[f']++map snd fs))+                  Right vs' -> stepTo (cons (vs++(map FValue vs')++map snd fs))         isDone (Strict, FValue _) = True         isDone (NonStrict, _) = True         isDone _ = False@@ -611,41 +796,25 @@ -- | Yield an 'MSOS' computation as a fully rewritten term. -- This function must be used in order to access entities in the definition -- of funcons.-compstep :: MSOS Funcons -> Rewrite Rewritten+compstep :: MSOS StepRes -> Rewrite Rewritten compstep mf = Rewrite $ \ctxt st ->      let f0 = local_fct ctxt      in (Right (CompTerm f0 mf), st, mempty) -tupleTypeTemplate :: [Funcons] -> [(Funcons, Maybe SeqSortOp)]-tupleTypeTemplate = map aux-    where   aux (FSortSeq f op) = (f, Just op)-            aux f               = (f, Nothing)-            --evalTupleType :: [(Funcons,Maybe SeqSortOp)] -> Rewrite Types-evalTupleType = fmap Tuples . evalTupleType' -    where-        evalTupleType' :: [(Funcons, Maybe SeqSortOp)] -> Rewrite [TTParam]-        evalTupleType' [] = return []-        evalTupleType' ((f,mop):fs) = rewriteFuncons f >>= \case-            ValTerm v -> case castType v of-              Just t -> ((t,mop):) <$> evalTupleType' fs -              Nothing-> sortErr(FValue v)"non-type value appeared in type tuple"-            CompTerm _ _ -> -                sortErr f"tuple type expressions may not contain compsteps"- --- transitive closure over steps-stepTrans :: RunOptions -> Int -> Funcons -> MSOS Funcons -stepTrans opts i f-    | isVal f || maybe False ((<= i)) (max_restarts opts) = return f-    | otherwise = if_abruptly_terminates (do_abrupt_terminate opts) -                    (stepAndOutput f) return continue-       where continue f' = do   count_restart-                                modifyCTXT setGlobal (stepTrans opts (i+1) f')-              where setGlobal ctxt = ctxt { ereader = -                                             (ereader ctxt) {global_fct = f' }}+stepTrans :: RunOptions -> Int -> StepRes -> MSOS StepRes+stepTrans opts i res = case res of +  Right vs -> return res+  Left f | maybe False ((<= i)) (max_restarts opts) -> return res+         | otherwise -> if_abruptly_terminates (do_abrupt_terminate opts) +                          (stepAndOutput f) return continue+       where continue res = count_restart >> stepTrans opts (i+1) res+             stepAndOutput :: Funcons -> MSOS StepRes              stepAndOutput f = MSOS $ \ctxt mut -> -                let MSOS stepper = evalFuncons f+                let MSOS stepper' = evalFuncons f+                    stepper ctxt mut = stepper' (setGlobal ctxt) mut+                    setGlobal ctxt = ctxt +                            { ereader = (ereader ctxt) {global_fct = f }}                 in do   (eres,mut',wr') <- stepper ctxt mut                         mapM_ (uncurry fprint)                              [ (entity,val) @@ -654,4 +823,13 @@                         return (eres, mut', wr')  +toStepRes :: Funcons -> StepRes+toStepRes (FValue v)  = Right [v]+toStepRes f           = Left f++flattenApplyWithExc :: IE -> (Funcons -> Funcons) -> MSOS StepRes -> Rewrite Rewritten+flattenApplyWithExc ie app m = compstep $ m >>= \case +    Left f    -> return $ Left $ app f+    Right [v] -> return $ Left $ app (FValue v)+    Right vs  -> msos_throw ie
src/Funcons/Parser.hs view
@@ -1,133 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module Funcons.Parser (Funcons.Parser.parse, Funcons.Parser.parser, pFuncons, pValues) where--import Text.ParserCombinators.Parsec--import Control.Applicative hiding ((<|>))-import Data.Char (isDigit)-import Data.Text (pack)-import Numeric--import Funcons.Lexer-import Funcons.Types--data Suffix = SuffixOp SeqSortOp-            | SuffixSort Funcons-            | SuffixBar Funcons-            | NoSuffix--pFuncons = applySuffix <$> pFuncons0 <*> mSuffix-    where   mSuffix :: Parser Suffix-            mSuffix =   SuffixOp <$> pOp-                    <|> SuffixSort <$ doubleArrow <*> pFuncons-                    <|> try (SuffixBar <$ bar <*> pFuncons) -- necessary for builtin maps-                    <|> return NoSuffix-            applySuffix f NoSuffix = f-            applySuffix f (SuffixOp op) = FSortSeq f op-            applySuffix f (SuffixSort f2) = FSortComputesFrom f f2-            applySuffix f (SuffixBar f2) = FSortUnion f f2---- introduced to bottom-out left-recursion-pFuncons0 :: Parser Funcons-pFuncons0 = -        FList           <$> brackets    (commaSep pFuncons)-    <|> try (FMap       <$> braces      (commaSep1 pKeyValue))-    <|> FSet            <$> braces      (commaSep pFuncons)-    <|> FTuple          <$> parens      (commaSep pFuncons)-    <|> FSortComputes   <$ doubleArrow <*> pFuncons-    <|> maybe_apply . pack  <$> identifier <*> optionMaybe pFuncons-    <|> FValue          <$> pValues- where  pKeyValue :: Parser Funcons-        pKeyValue = (\x y -> FTuple [x,y]) <$> pFuncons <* barredArrow <*> pFuncons-       -        maybe_apply :: Name -> Maybe Funcons -> Funcons-        maybe_apply nm mf = case mf of -                            Nothing     -> FName nm-                            Just arg    -> FApp nm arg---pOp :: Parser SeqSortOp-pOp =       StarOp <$ reserved "*"-        <|> PlusOp <$ reserved "+"-        <|> QuestionMarkOp <$ reserved "?"--pValues :: Parser Values -pValues =-        Char <$ char '\'' <*> anyChar <* char '\'' -    <|> String <$> stringLiteral -    <|> EmptyTuple <$ reserved "void" -    <|> List [] <$ reserved "nil"-    <|> String "\n" <$ reserved "newline" -    <|> (\(FValue v) -> v) . int_ . (0-) . readInt <$ char '-' <*> (many1 digit) -    <|> (\(FValue v) -> v) . nat_ . readInt <$> (many1 digit) -    <|> Atom <$ reserved "atom" <*> parens stringLiteral-    <|> mk_rationals . readRational-            <$> ((\m l -> m ++ "." ++ l) <$> many1 (satisfy isDigit) <* period <*>-                                             many1 (satisfy isDigit))-  where readInt :: String -> Int-        readInt = read --{--ComputationTypes and Types should really be parsed as arbitrary terms,-    then evaluated to ComputationType/Type.-However, computation types can currently not be parsed because of left-recursion (see above).--pComputationType :: Parser ComputationTypes-pComputationType =  Type <$> pTypes-                <|> ComputesType <$ reserved "=>" <*> pTypes -                <|> ComputesFromType <$> pTypes <* reserved "=>" <*> pTypes --pTypes :: Parser Types-pTypes =-        Atoms <$ reserved "atoms"-    <|> AsciiCharacters <$ reserved "ascii-characters"-    <|> reserved "bounded-integers" *> -            parens (BoundedIntegers <$> natural <* comma <*> natural)-    <|> ComputationTypes <$ reserved "computation-types"-    <|> EmptyType <$ reserved "empty-type"-    <|> UnicodeCharacters <$ reserved "unicode-characters"-    <|> Integers <$ reserved "integers"-    <|> Strings <$ reserved "strings"-    <|> Values <$ reserved "values" -    <|> reserved "maps" *> parens (Maps <$> pTypes <* comma <*> pTypes)-    <|> Types <$ reserved "types"-    <|> ADTs <$ reserved "algebraic-datatypes"---    <|> ADT      -    <|> reserved "bits" *> parens (Bits . fromInteger <$> natural)-    <|> IEEEFloats <$ reserved "ieee-floats" <*> parens pIEEEFormat-    <|> Lists <$ reserved "lists" <*> parens pTypes-    <|> Multisets <$ reserved "multisets" <*> parens pTypes-    <|> Naturals <$ reserved "naturals"-    <|> Rationals <$ reserved "rationals"-    <|> Thunks <$ reserved "thunks" <*> parens pComputationType-    <|> Sets <$ reserved "sets" <*> parens pTypes-    <|> Vectors <$ reserved "vectors" <*> parens pTypes---    <|> Tuples <$ reserved "tuples" <*> parens (commaSep pTypes)---    <|> parens (Union <$> pTypes <* reserved "|" <*> pTypes)--}--pIEEEFormat :: Parser IEEEFormats-pIEEEFormat =   Binary32 <$ reserved "binary32"-            <|> Binary64 <$ reserved "binary64"--readRational :: String -> Rational-readRational = fst . head . readFloat-----------parse :: FilePath -> String -> Funcons-parse = parser (whiteSpace *> pFuncons <* whiteSpace)--parser :: Parser a -> FilePath -> String -> a -parser p fp str = case Text.ParserCombinators.Parsec.parse p fp str of-                    Left err -> error (show err)-                    Right a  -> a--reader :: Parser a -> FilePath -> String -> [(a, String)]-reader p fp str = [(parser p fp str, "")]+module Funcons.Parser (fct_parse, fvalue_parse) where -instance Read Funcons where-    readsPrec d str = reader pFuncons "" str+import Funcons.GLLParser (fct_parse, fvalue_parse) -instance Read Values where-    readsPrec d str = reader pValues "" str
src/Funcons/Patterns.hs view
@@ -1,4 +1,7 @@-{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE LambdaCase, StandaloneDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE OverloadedStrings #-}  module Funcons.Patterns where @@ -7,12 +10,14 @@ import Funcons.Substitution import Funcons.Exceptions -import Control.Monad (foldM)+import Control.Applicative+import Control.Monad (foldM, forM) import Data.Function (on)-import Data.List (sortBy)+import Data.List (sortBy, intercalate) import Data.Monoid import Data.Text (unpack)-import qualified Data.BitVector as BV+import Data.Foldable (toList)+import qualified Data.Map as M   -- pattern matching type Matcher a = [a] -> Int -> Env -> Rewrite [(Int, Env)]@@ -48,10 +53,10 @@                 Left ie | failsRule ie  -> return []                         | otherwise     -> rewrite_rethrow ie -matching :: [a] -> [Matcher a] -> Env -> Rewrite Env-matching str ps env = do +matching :: (a -> String) -> [a] -> [Matcher a] -> Env -> Rewrite Env+matching show str ps env = do      matches <- (seqms ps) str 0 env -    let rule_fail = PatternMismatch ("Pattern match failed: " ++ show (map fst matches))+    let rule_fail = PatternMismatch ("Pattern match failed: " ++ intercalate "," (map show str))     case matches of         [] -> rewrite_throw rule_fail         [(_,env')] -> return env'@@ -92,6 +97,7 @@                 | PSeqVar MetaVar SeqSortOp                 | PAnnotated FPattern FTerm                  | PWildCard+                deriving (Show, Eq, Ord, Read)  f2vPattern :: FPattern -> VPattern f2vPattern (PValue v) = v@@ -103,21 +109,67 @@ -- | Patterns for matching values ('Values'). data VPattern   = PADT Name [VPattern]                 | VPWildCard-                | PEmptySet-                | PTuple [VPattern]-                | PList [VPattern]+--                | PList [VPattern]                 | VPMetaVar MetaVar                  | VPAnnotated VPattern FTerm                  | VPSeqVar MetaVar SeqSortOp                 | VPLit Values +                | VPType TPattern+                deriving (Show, Eq, Ord, Read) +v2tPattern :: VPattern -> Maybe TPattern+v2tPattern (VPType t) = Just t+v2tPattern (VPMetaVar var) = Just $ TPVar var+v2tPattern (VPSeqVar var op) = Just $ TPSeqVar var op+v2tPattern (PADT cons pats) = TPADT cons <$> mapM v2tPattern pats+v2tPattern (VPLit lit) = Just $ TPLit (TFuncon (FValue lit))+v2tPattern VPWildCard = Just TPWildCard+--v2tPattern (PList _) = Nothing  +v2tPattern (VPAnnotated fp t) = Nothing ++-- required for "matching" lazy arguments (fields) of adt constructors+v2fPattern :: VPattern -> FPattern+v2fPattern (VPMetaVar x)          = PMetaVar x+v2fPattern (VPSeqVar x op)        = PSeqVar x op+v2fPattern (VPAnnotated pat ann)  = PAnnotated (v2fPattern pat) ann+v2fPattern VPWildCard             = PWildCard+v2fPattern vp                     = PValue vp++substitute_patt_signal :: VPattern -> Env -> Rewrite VPattern+substitute_patt_signal vpat env = case vpat of +  PADT name vpats -> PADT name <$> subs_flatten vpats env+  VPWildCard      -> return VPWildCard+--  PList pats      -> PList <$> subs_flatten pats env+  VPMetaVar var   -> case M.lookup var env of+                      Nothing -> return (VPMetaVar var)+                      Just v  -> VPLit <$> vLevel v+  VPAnnotated vpat ann  -> VPAnnotated <$> substitute_patt_signal vpat env +                                       <*> return ann +  VPSeqVar var op -> case M.lookup var env of+                      Nothing -> return (VPSeqVar var op)+                      Just v  -> VPLit <$> vLevel v +  VPLit lit       -> return $ VPLit lit+  VPType tpat     -> return $ VPType tpat -- assumes type patterns do not occur in signals+  where subs_flatten :: [VPattern] -> Env -> Rewrite [VPattern]+        subs_flatten terms env = (concat <$>) $ forM terms $ \case+              vpat@(VPMetaVar k)   -> envMaybeLookup env k vpat+              vpat@(VPSeqVar k op) -> envMaybeLookup env k vpat+              vpat                 -> (:[]) <$> substitute_patt_signal vpat env++        envMaybeLookup :: Env -> MetaVar -> VPattern -> Rewrite [VPattern] +        envMaybeLookup env k vpat = case M.lookup k env of+                            Nothing -> return [vpat]+                            Just lf -> map VPLit <$> vsLevel lf++ -- | Variant of 'vsMatch' that is lifted into the 'MSOS' monad. lifted_vsMatch str pats env = liftRewrite $ vsMatch str pats env -- | Matching values with value patterns patterns. -- If the list of patterns is a singleton list, then 'vsMatch' attempts -- to match the values as a tuple against the pattern as well. vsMatch :: [Values] -> [VPattern] -> Env -> Rewrite Env -vsMatch str pats env = case pats of+vsMatch str pats env = strict_vsMatch str pats env+{-case pats of     [pat]   -> do         e_ie_env <- eval_catch (strict_vsMatch str [pat] env)         case e_ie_env of@@ -125,23 +177,28 @@             Left ie | failsRule ie -> vMatch (safe_tuple_val str) pat env                     | otherwise -> rewrite_rethrow ie     _       -> strict_vsMatch str pats env+-}  -- | Match stricly values with patterns. strict_vsMatch :: [Values] -> [VPattern] -> Env -> Rewrite Env-strict_vsMatch str pats env = matching str matchers env-        where   matchers = map (toMatcher vMatch vpSeqVarInfo) pats-                toMatcher prop minfo pat = case minfo pat of+strict_vsMatch str pats env +  | all isSort_ str +  , Just tpats <- sequence (map v2tPattern pats)+        = tsMatch (map (downcastSort . FValue) str) tpats env +  | otherwise = matching showValues str matchers env+        where   matchers = map toMatcher pats+                toMatcher pat = case vpSeqVarInfo pat of                     Just info   -> seqMatcher isInMaybeTermType ValuesTerm info-                    Nothing     -> singleMatcher prop pat +                    Nothing     -> singleMatcher vMatch pat   -- | Variant of 'premiseStep' that applies substitute and pattern-matching. premise :: FTerm -> FPattern -> Env -> MSOS Env-premise x pat env = do-    f <- liftRewrite (substitute x env)-    case isVal f of-        True -> msos_throw (SideCondFail "attempting to step a value")-        False -> do f' <- premiseStep f -                    liftRewrite $ (fMatch f' pat env)+premise x pat env = liftRewrite (subsAndRewritesInEnv x env) >>= \case+  (ValTerm v, env')       -> msos_throw (StepOnValue v)+  (CompTerm f step,env')  -> do +      ef' <- count_delegation >> optRefocus step +      case ef' of Left f'   -> liftRewrite $ fMatch f' pat env'+                  Right vs' -> liftRewrite $ fsMatch (map FValue vs') [pat] env'  -- | Variant of 'fsMatch' that is lifted into the 'MSOS' monad. -- If all given terms are values, then 'vsMatch' is used instead.@@ -152,32 +209,39 @@ fsMatchStrictness :: Bool -> [Funcons] -> [FPattern] -> Env -> Rewrite Env fsMatchStrictness strict str pats env      -- if all the given funcons are values, then perform value matching instead.-    | not strict && all isVal str = vsMatch (map downcastValue str) (map f2vPattern pats) env-    | otherwise     = matching str matchers env-    where   matchers = map (toMatcher fMatch fpSeqVarInfo) pats-            toMatcher prop minfo pat = case minfo pat of-                Just info   -> seqMatcher (\_ _ _ -> return True) FunconsTerm info-                Nothing     -> singleMatcher prop pat+    | not strict && all (not.hasStep) str = +          let downValues vs = map downcastValue vs+          in vsMatch (downValues str) (map f2vPattern pats) env+    | otherwise = matching showFuncons str matchers env+    where   matchers = map toMatcher pats+            toMatcher pat = case fpSeqVarInfo pat of+                Just info   -> seqMatcher rewritesToAnnotatedType FunconsTerm info+                Nothing     -> singleMatcher fMatch pat  fMatch :: Funcons -> FPattern -> Env -> Rewrite Env  fMatch _ PWildCard env = return env-fMatch f (PMetaVar var) env = return (envInsert var (FunconTerm f) env)+fMatch f (PMetaVar var) env = return (envInsert var (FunconTerm f Nothing) env) fMatch f (PAnnotated pat term) env = do-    ty <- subsAndRewrite term env-    let fail = rewrite_throw (PatternMismatch ("pattern annotation check failed: " ++ show ty))-    rewriteFuncons f >>= \case  -        ValTerm v   -> do   b <- isIn v ty-                            if b then vMatch v (f2vPattern pat) env-                                 else fail   +    tys <- subsAndRewritesToValues term env+    let fail = rewrite_throw (PatternMismatch ("pattern annotation check failed: " ++ showValuesSeq tys))+    rewriteFunconsWcount f >>= \case  +        ValTerm vs  -> do   b <- isInTuple vs tys +                            if b then vsMatch vs [f2vPattern pat] env+                                 else fail         otherwise   -> fail  -- * a sequence variable can match the singleton sequence  fMatch f pat@(PSeqVar _ _) env = fsMatch [f] [pat] env -- if the pattern is a value attempt evaluation by rewrite-fMatch f (PValue pat) env = rewriteFuncons f >>= -    \case   ValTerm v -> vMatch v pat env+fMatch f (PValue pat) env = rewriteFunconsWcount f >>= +    \case   ValTerm vs -> vsMatch vs [pat] env             CompTerm _ _ -> rewrite_throw --important, should remain last                  (PatternMismatch ("could not rewrite to value: " ++ showFuncons f)) +lifted_fMaybeMatch mf mp env = liftRewrite $ fMaybeMatch mf mp env+fMaybeMatch Nothing Nothing env = return env+fMaybeMatch (Just f) (Just p) env = fMatch f p env+fMaybeMatch _ _ env = rewrite_throw (PatternMismatch "fMaybeMatch")+ lifted_vMaybeMatch mv mp env = liftRewrite $ vMaybeMatch mv mp env vMaybeMatch :: Maybe Values -> Maybe VPattern -> Env -> Rewrite Env vMaybeMatch Nothing Nothing env = return env@@ -186,40 +250,65 @@  lifted_vMatch v p env = liftRewrite $ vMatch v p env vMatch :: Values -> VPattern -> Env -> Rewrite Env+-- builtin special case for builtin value constructor `datatype-value`+vMatch (ADTVal str vs) (PADT "datatype-value" pats) env = +  adtMatch "" "" (string_ (unpack str):vs) pats env vMatch _ (VPWildCard) env = return env+vMatch VAny _ env = return env vMatch v (VPMetaVar var) env = return (envInsert var (ValueTerm v) env)-vMatch (Set s) PEmptySet env | null s = return env-vMatch EmptyTuple (PTuple pats) env = vsMatch [] pats env-vMatch (NonEmptyTuple v1 v2 vs) (PTuple pats) env = vsMatch (v1:v2:vs) pats env vMatch (ADTVal str vs) (PADT con pats) env = adtMatch str con vs pats env -- strict because we do not want to match the sequence "inside" the list-vMatch (List vs) (PList ps) env = strict_vsMatch vs ps env +--vMatch (List vs) (PList ps) env = strict_vsMatch vs ps env  vMatch v (VPAnnotated pat term) env = do-    ty <- subsAndRewrite term env+    ty <- subsAndRewritesToValue term env     isIn v ty >>= \case         True  -> vMatch v pat env-        False -> rewrite_throw (PatternMismatch ("pattern annotation check failed: " ++ show ty))+        False -> rewrite_throw (PatternMismatch ("pattern annotation check failed: " ++ showValues ty)) vMatch v (VPLit v2) env | v == v2 = return env -- special treatment for sequence variables: -- * a (single) sequence variable can match a tuple-vMatch EmptyTuple pat@(VPSeqVar _ _) env = vsMatch [] [pat] env-vMatch (NonEmptyTuple v1 v2 vs) pat@(VPSeqVar _ _) env = vsMatch (v1:v2:vs) [pat] env -- * a sequence variable can match the singleton sequence vMatch v pat@(VPSeqVar _ _) env = vsMatch [v] [pat] env -- * a single value can match a tuple of patterns if it contains sequences-vMatch v (PTuple pats) env = vsMatch [v] pats env +vMatch (ComputationType ty) (VPType pat) env = tMatch ty pat env vMatch v _ _ = rewrite_throw (PatternMismatch ("failed to match")) +tsMatch :: [ComputationTypes] -> [TPattern] -> Env -> Rewrite Env+tsMatch = strict_tsMatch -adtMatch :: Name -> Name -> [Values] -> [VPattern] -> Env -> Rewrite Env-adtMatch con pat_con vs pats env +strict_tsMatch :: [ComputationTypes] -> [TPattern] -> Env -> Rewrite Env+strict_tsMatch str pats env = matching showSorts str matchers env+        where   matchers = map toMatcher pats+                toMatcher pat = case tpSeqVarInfo pat of+                  Nothing -> singleMatcher tMatch pat +                  Just info -> seqMatcher (\_ _ _ -> return True) TypesTerm info++tMatch :: ComputationTypes -> TPattern -> Env -> Rewrite Env+tMatch t p env = case p of+  TPWildCard -> return env+  TPVar x -> return (envInsert x (TypeTerm t) env)+  TPSeqVar _ _ -> tsMatch [t] [p] env+  TPLit ft -> subsAndRewritesToValue ft env >>= \case +    ComputationType ty ->   +      if t == ty then return env +                 else rewrite_throw (PatternMismatch ("failed to match"))+    _ -> internal "type-pattern literal not a type"+  TPComputes fp | ComputesType ft <- t -> tMatch (Type ft) fp env+  TPComputesFrom fp tp | ComputesFromType ft tt <- t -> +    tMatch (Type ft) fp env >>= tMatch (Type tt) tp +  TPADT nm ps | Type (ADT nm' ts) <- t,  nm == nm' ->+    fsMatch ts (map (PValue . VPType) ps) env -- TODO change ps to value pattern (also in generator, see other TODO)+  _ -> rewrite_throw (PatternMismatch ("failed to match"))++adtMatch :: Name -> Name -> [Funcons] -> [VPattern] -> Env -> Rewrite Env+adtMatch con pat_con vs vpats env      | con /= pat_con = rewrite_throw (PatternMismatch ("failed to match constructors: (" ++ show (con,pat_con) ++ ")"))-    | otherwise = vsMatch vs pats env+    | otherwise = fsMatch vs (map v2fPattern vpats) env   fpSeqVarInfo :: FPattern -> Maybe SeqVarInfo fpSeqVarInfo (PSeqVar var op) = Just (var, op, Nothing)-fpSeqVarInfo (PAnnotated (PSeqVar var op) _) = Just (var, op, Nothing)+fpSeqVarInfo (PAnnotated (PSeqVar var op) term) = Just (var, op, Just term) fpSeqVarInfo _ = Nothing  vpSeqVarInfo :: VPattern -> Maybe SeqVarInfo @@ -227,6 +316,9 @@ vpSeqVarInfo (VPAnnotated (VPSeqVar var op) term) = Just (var, op, Just term) vpSeqVarInfo _ = Nothing +tpSeqVarInfo :: TPattern -> Maybe SeqVarInfo+tpSeqVarInfo (TPSeqVar var op) = Just (var, op, Nothing)+tpSeqVarInfo _ = Nothing  -- | CSB supports five kinds of side conditions. -- Each of the side conditions are explained below.@@ -254,91 +346,115 @@ sideCondition :: SideCondition -> Env -> Rewrite Env sideCondition cs env = case cs of     SCEquality term1 term2 -> -        prop "equality condition" (\a b -> return (a === b)) term1 term2 env+        prop "equality condition" (lift allEqual) term1 term2 env     SCInequality term1 term2 ->     -        prop "inequality condition" (\a b -> return (a =/= b))term1 term2 env-    SCIsInSort term1 term2 -> prop "type-check condition" isIn term1 term2 env+        prop "inequality condition" (lift allUnEqual) term1 term2 env+    SCIsInSort term1 term2 -> prop "sort annotation" isInTuple term1 term2 env     SCNotInSort term1 term2 -> -        prop "type-check condition" (\a b -> isIn a b >>= return . not) term1 term2 env-    SCPatternMatch term vpat -> do-        -- special treatment of pattern-matching condition -        f <- substitute term env-        eval_catch (rewriteFuncons f) >>= \case-            Right (ValTerm v)       -> vMatch v vpat env-            Right (CompTerm lf _)   -> fMatch lf pat env-            Left (_,_,PartialOp _)  -> fMatch f pat env-            Left ie                 -> rewrite_rethrow ie+        prop "neg. sort annotation" (\a b -> isInTuple a b >>= return . not) term1 term2 env+    SCPatternMatch term vpat -> +      eval_catch (subsAndRewritesInEnv term env) >>= \case +            -- env' binds term to step or value, if possible +            --  courtesy of subsAndRewritesInEnv+            Right (ValTerm vs, env')        -> vsMatch vs [vpat] env'+            Right (CompTerm lf step, env')  -> case vpat of +              VPMetaVar v -> return (envInsert v (FunconTerm lf (Just step)) env')+              _           -> fMatch lf pat env'+            Left (_,lf,PartialOp _)     -> fMatch lf pat env+            Left ie                     -> rewrite_rethrow ie       where pat = case vpat of                       VPMetaVar var   -> PMetaVar var                        value_pat       -> PValue value_pat-  where prop msg op term1 term2 env = do-            v1 <- subsAndRewrite term1 env-            v2 <- subsAndRewrite term2 env-            b <- op v1 v2-            if b then return env-                 else rewrite_throw (SideCondFail (msg ++ " fails"))-+  where prop :: String -> ([Values] -> [Values] -> Rewrite Bool) -> FTerm -> FTerm -> Env -> Rewrite Env+        prop msg op term1 term2 env = do+            (vs1,env1) <- subsAndRewritesToValuesInEnv term1 env+            (vs2,env2) <- subsAndRewritesToValuesInEnv term2 env1+            b <- op vs1 vs2+            if b then return env2+                 else rewrite_throw (SideCondFail (msg ++ " fails with " ++ showValuesSeq vs1 ++ " and " ++ showValuesSeq vs2))+        lift op xs ys = return (op xs ys)+       -- piggy back on -matchTypeParams :: [Types] -> [TypeParam] -> Rewrite Env+matchTypeParams :: [ComputationTypes] -> [TypeParam] -> Rewrite Env matchTypeParams tys tparams =      let param_pats = map mkPattern tparams-         where mkPattern (Nothing, kind)  = VPAnnotated VPWildCard kind-               mkPattern (Just var, kind) = VPAnnotated (VPMetaVar var) kind-    in vsMatch (map typeVal tys) param_pats emptyEnv +         where mkPattern (Nothing, _, kind)  = VPAnnotated VPWildCard kind+               mkPattern (Just var, Nothing, kind) = VPAnnotated (VPMetaVar var) kind+               mkPattern (Just var, Just op, kind) = VPAnnotated (VPSeqVar var op) kind+    in vsMatch (map ComputationType tys) param_pats emptyEnv   +alwaysAccept :: Funcons -> Maybe FTerm -> Env -> Rewrite Bool+alwaysAccept _ _ _ = return True++rewritesToAnnotatedType :: Funcons -> Maybe FTerm -> Env -> Rewrite Bool+rewritesToAnnotatedType f Nothing _ = return True+rewritesToAnnotatedType f (Just term) env = rewriteFunconsWcount f >>= \case +  ValTerm [v]   -> isInMaybeTermType v (Just term) env +  ValTerm vs    -> isInMaybeTupleType vs term env+  CompTerm _  _ -> return False+ -- type checking isInMaybeTermType :: Values -> (Maybe FTerm) -> Env -> Rewrite Bool isInMaybeTermType v Nothing _ = return True isInMaybeTermType v (Just term) env = -    subsAndRewrite term env >>= isIn v+    subsAndRewritesToValue term env >>= isIn v +-- | To type check a sequence values simply checker whether all elements+-- of the sequence are of the given type+isInMaybeTupleType :: [Values] -> FTerm -> Env -> Rewrite Bool+isInMaybeTupleType vs term env = +  subsAndRewritesToValue term env >>= isInTuple vs . (:[])++isInTuple :: [Values] -> [Values] -> Rewrite Bool+isInTuple vs mtys = case sequence (map castType mtys) of+  Nothing  -> sortErr (FValue $ ADTVal "" (map FValue mtys)) +                "rhs of annotation is not a type"+  Just tys -> Funcons.Patterns.isInTupleType vs (map mkParam tys)+  where mkParam (AnnotatedType ty op) = (ty, Just op)+        mkParam ty = (ty, Nothing)+  isIn :: Values -> Values -> Rewrite Bool isIn v mty = case castType mty of     Nothing -> sortErr (FValue mty) "rhs of annotation is not a type"-    Just ty -> isInType v ty-+    Just ty -> Funcons.Patterns.isInType v ty+   isInType :: Values -> Types -> Rewrite Bool isInType v (ADT nm tys) = do-    DataTypeMembers tparams alts <- typeEnvLookup nm-    env <- matchTypeParams tys tparams -    or <$> mapM (isInAlt env) alts - where isInAlt env (DataTypeInclusion ty_term) = do -            subsAndRewrite ty_term env >>= isIn v -       isInAlt env (DataTypeConstructor cons ty_term) = case v of-            ADTVal cons' arg | cons' == cons ->-                subsAndRewrite ty_term env >>= isIn (safe_tuple_val arg)-            _ -> return False-isInType (ADTVal _ _) ADTs = return True-isInType (Atom _) Atoms = return True-isInType (Ascii _) AsciiCharacters = return True-isInType (Bit bv) (Bits n) = return (BV.size bv == n)-isInType v (BoundedIntegers m n) -    | Int i <- upcastIntegers v = return (i >= m && i <= n)-isInType (ComputationType (ComputesFromType _ _)) ComputationTypes = return True-isInType (ComputationType (ComputesType _)) ComputationTypes = return True-isInType _ EmptyType = return False-isInType (IEEE_Float_32 _) (IEEEFloats Binary32) = return True-isInType (IEEE_Float_64 _) (IEEEFloats Binary64) = return True-isInType v Integers | Int _ <- upcastIntegers v = return True-isInType (List _) (Lists _) = return True -isInType (Map _) (Maps _ _) = return True-isInType (Multiset _) (Multisets _) = return True -isInType v Naturals | Nat _ <- upcastNaturals v = return True-isInType v Rationals | Rational _ <- upcastRationals v = return True -isInType (Set _) (Sets _) = return True-isInType (String _) Strings = return True-isInType (Thunk _) (Thunks _) = return True-isInType v (Tuples ttparams) = case v of-    EmptyTuple              -> isInTupleType [] ttparams-    NonEmptyTuple v1 v2 vs  -> isInTupleType (v1:v2:vs) ttparams-    _                       -> isInTupleType [v] ttparams-isInType (ComputationType (Type _)) Types = return True-isInType v UnicodeCharacters | Char _ <- upcastUnicode v = return True-isInType v (Union ty1 ty2) = (||) <$> isInType v ty1 <*> isInType v ty2-isInType _ Values = return True-isInType (Vector _) (Vectors _) = return True-isInType _ _ = return False+    DataTypeMemberss _ tpats alts <- typeEnvLookup nm+    or <$> mapM (isInAlt tpats) alts + where isInAlt tpats (DataTypeInclusionn ty_term) = do +            -- TODO change DataTypeMember so that tpats are value-patterns+            --      requires change in the generator+            env <- fsMatch tys (map (PValue . VPType) tpats) emptyEnv+            subsAndRewritesToValue ty_term env >>= isIn v +       isInAlt tpats (DataTypeMemberConstructor cons ty_terms mtpats)+        | ADTVal cons' args <- v, cons' == cons = do+          env <- case mtpats of +                  Just tpats -> fsMatch tys (map (PValue . VPType) tpats) emptyEnv+                  Nothing    -> fsMatch tys (map (PValue . VPType) tpats) emptyEnv+          case all (not.hasStep) args of +            True  -> mapM (flip subsAndRewritesToValues env) ty_terms >>= +                        isInTuple (map downcastValue args) . concat+            _     -> return True -- imprecision+       isInAlt _ _ = return False+isInType v (AnnotatedType ty op) = Funcons.Patterns.isInTupleType [v] [(ty, Just op)] +isInType (Map m) (Maps kt vt) = +  and <$> sequence [and <$> mapM (flip Funcons.Patterns.isInType kt) (M.keys m)+                   ,and <$> mapM (flip Funcons.Patterns.isInType vt) (M.elems m)]+isInType (Multiset ls) (Multisets ty) = +  and <$> mapM (flip Funcons.Patterns.isInType ty) (toList ls)+isInType (Set ls) (Sets ty) = +  and <$> mapM (flip Funcons.Patterns.isInType ty) (toList ls)+isInType (Vector ls) (Vectors ty) = +  and <$> mapM (flip Funcons.Patterns.isInType ty) (toList ls)+isInType v (Union ty1 ty2) = +  (||) <$> Funcons.Patterns.isInType v ty1 <*> Funcons.Patterns.isInType v ty2+isInType v (Intersection ty1 ty2) = +  (&&) <$> Funcons.Patterns.isInType v ty1 <*> Funcons.Patterns.isInType v ty2+isInType v (Complement t) = +  not <$> Funcons.Patterns.isInType v t+isInType v t = maybe (return False) return (Funcons.Types.isInType v t)  isInTupleType :: [Values] -> [TTParam] -> Rewrite Bool isInTupleType vs ttparams = @@ -346,11 +462,10 @@         Right env' -> return True         Left (_,_,PatternMismatch _) -> return False         Left ie -> rewrite_rethrow ie -    where mkPattern (ty, mop) = VPAnnotated ty_pat (TFuncon ty_funcon)+    where mkPattern (ty, mop) = VPAnnotated ty_pat (TFuncon (type_ ty))             where ty_pat = case mop of                                  Nothing -> VPMetaVar "Dummy"                                 Just op -> VPSeqVar "Dummy" op-                  ty_funcon = type_ ty  typeEnvLookup :: Name -> Rewrite DataTypeMembers  typeEnvLookup con = Rewrite $ \ctxt st -> @@ -362,9 +477,36 @@ -- |  -- Parameterisable evaluation function function for types. rewriteType :: Name -> [Values] -> Rewrite Rewritten-rewriteType nm vs -    | all isType_ vs = -        rewritten (ComputationType(Type(ADT nm (map downcastValueType vs))))-    | otherwise = sortErr (applyFuncon nm (map FValue vs)) -                    ("argument of type " <> unpack nm <> " is not a type") +rewriteType nm vs = rewritten (ComputationType(Type(ADT nm (map inject vs))))++pat2term :: FPattern -> FTerm+pat2term pat = case pat of+  PAnnotated pat _  -> pat2term pat+  PWildCard         -> TAny+  PMetaVar var      -> TVar var+  PSeqVar var _     -> TVar var+  PValue vpat       -> vpat2term vpat++vpat2term :: VPattern -> FTerm +vpat2term vpat = case vpat of +  PADT cons pats    -> case pats of [] -> TName cons+                                    _  -> TApp cons (map vpat2term pats)+  VPLit lit         -> TFuncon $ (FValue lit) +  VPWildCard        -> TAny+--  PList pats        -> TList (map vpat2term pats)+  VPMetaVar var     -> TVar var+  VPSeqVar var _    -> TVar var+  VPAnnotated pat _ -> vpat2term pat+  VPType typat      -> typat2term typat++typat2term :: TPattern -> FTerm+typat2term typat = case typat of +  TPADT cons pats     -> case pats of [] -> TName cons+                                      _  -> TApp cons (map typat2term pats)+  TPLit lit           -> lit +  TPWildCard          -> TAny+  TPVar var           -> TVar var+  TPSeqVar var _      -> TVar var+  TPComputes f        -> TSortComputes (typat2term f)+  TPComputesFrom f t  -> TSortComputesFrom (typat2term f) (typat2term t)
src/Funcons/Printer.hs view
@@ -1,145 +1,79 @@ {-# LANGUAGE OverloadedStrings #-}  module Funcons.Printer (-    ppFuncons, ppValues, ppTypes,-    showValues, showFuncons, showTypes,+    ppFuncons, ppValues, ppTypes, ppTerms,+    showValues, showFuncons, showTypes, showSorts, showTerms, showOp,+    showValuesSeq, ppValuesSeq, showFunconsSeq, ppFunconsSeq,     ) where  import Funcons.Types import Funcons.RunOptions  import Data.List (intercalate)-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 qualified Data.BitVector as BV import Data.Text (unpack)  -- | Pretty-print a 'Values'. showValues :: Values -> String-showValues = ppValues defaultRunOptions +showValues = ppValues showFuncons  +-- | Pretty-print a sequence of `Values`.+showValuesSeq :: [Values] -> String+showValuesSeq = ppValuesSeq defaultRunOptions++showOp :: SeqSortOp -> String+showOp = ppOp++ppValuesSeq :: RunOptions -> [Values] -> String+ppValuesSeq opts = showArgs opts False . map FValue+ -- | Pretty-print a 'Funcons'. showFuncons :: Funcons -> String showFuncons = ppFuncons defaultRunOptions --- | Pretty-print a 'Types'. +-- | Pretty-print a sequence of `Funcons`.+showFunconsSeq :: [Funcons] -> String+showFunconsSeq = ppFunconsSeq defaultRunOptions++ppFunconsSeq :: RunOptions -> [Funcons] -> String+ppFunconsSeq opts = showArgs opts False++-- | Pretty-print a 'Types'. showTypes :: Types -> String-showTypes = ppTypes defaultRunOptions+showTypes = ppTypes showFuncons  +-- | Pretty-print a sort or 'ComputationType'+showSorts :: ComputationTypes -> String+showSorts = ppComputationTypes showFuncons ++showTerms :: FTerm -> String+showTerms = ppTerms defaultRunOptions+ ppFuncons :: RunOptions -> Funcons -> String-ppFuncons opts (FList fs)    = "[" ++ showArgs opts False fs ++ "]"-ppFuncons opts (FTuple fs)   = "(" ++ showArgs opts False fs ++ ")"+ppFuncons opts (FApp "list" fs) = "[" ++ showArgs opts False fs ++ "]"+--ppFuncons opts (FTuple fs)   = "(" ++ showArgs opts False fs ++ ")" ppFuncons opts (FSet fs)     = "{" ++ showArgs opts False fs ++ "}"-ppFuncons opts (FMap fs)     = "{" ++ intercalate "," (map toKeyFValue fs) ++ "}"- where  toKeyFValue (FTuple [k,v]) = ppFuncons opts k ++ " |-> " ++ ppFuncons opts v-        toKeyFValue _ = error "pretty-print map"-ppFuncons opts (FValue v)            = ppValues opts v+ppFuncons opts (FMap fs)     = +  "{" ++ intercalate "," (map toKeyFValue $ mkPairs fs) ++ "}"+ where  toKeyFValue (k,v) = ppFuncons opts k ++ " |-> " ++ ppFuncons opts v+ppFuncons opts (FValue v)            = ppValues (ppFuncons opts) v ppFuncons opts (FName nm)      = unpack nm-ppFuncons opts (FSortSeq f o)  = ppFuncons opts f ++ ppOp o  +ppFuncons opts (FSortSeq f o)  = ppFuncons opts f ++ ppOp o+ppFuncons opts (FSortPower f1 f2) = ppFuncons opts f1 ++ "^" ++ ppFuncons opts f2 ppFuncons opts (FSortUnion f1 f2) = "(" ++ ppFuncons opts f1 ++ "|" ++ ppFuncons opts f2 ++ ")"+ppFuncons opts (FSortInter f1 f2) = "(" ++ ppFuncons opts f1 ++ "&" ++ ppFuncons opts f2 ++ ")"+ppFuncons opts (FSortComplement f1) = "~("++ ppFuncons opts f1 ++ ")" ppFuncons opts (FSortComputes f) = "=>" ++ ppFuncons opts f ppFuncons opts (FSortComputesFrom s t) = ppFuncons opts s ++ "=>" ++ ppFuncons opts t -- some hard-coded funcons-ppFuncons opts (FApp "closure" (FTuple [x, y])) =+ppFuncons opts (FApp "closure" [x, y]) =     let env | pp_full_environments opts = y             | otherwise                 = string_ "..."     in showFn opts "closure" [x, env]-ppFuncons opts (FApp "scope" (FTuple [x, y])) =+ppFuncons opts (FApp "scope" [x, y]) =     let env | Prelude.not (pp_full_environments opts) && isMap x = string_ "..."             | otherwise                                          = x     in showFn opts "scope" [env, y]-ppFuncons opts (FApp nm f)     = unpack nm ++ ppFuncons opts f--ppValues :: RunOptions -> Values -> String-ppValues opts (ADTVal c []) = unpack c-ppValues opts (ADTVal c vs) = unpack c ++ showArgs opts True (map FValue vs) -ppValues _ (Atom c)       = "atom("++ c ++")"-ppValues _ (Ascii c)      = "`" ++ [toEnum c] ++ "`"-ppValues _ (Bit i)        = "bits(" ++ show (BV.size i)-                                        ++ ", " ++ show (BV.int i) ++ ")"-ppValues _ (Char c)       = show c-ppValues _ (Float f)      = show f--- rationals-ppValues _ (IEEE_Float_32 f) = show f-ppValues _ (IEEE_Float_64 d) = show d-ppValues _ (Rational r)   = show r-ppValues _ (Int f)        = show f-ppValues _ (Nat f)        = show f-ppValues opts (List vs)      =   if Prelude.null vs-                                then "[]"-                                else "[" ++ showArgs opts False (map FValue vs) ++ "]"-ppValues opts (Map m)        = if M.null m then "map-empty"-                               else "{" ++ key_values ++ "}"- where key_values = intercalate ", " (map (\(k,v) -> ppValues opts k++" |-> "++ -                                                     ppValues opts v)$ M.toList m)-ppValues opts (Multiset s) -    | MS.size s == 0 = "{}"-    | otherwise = "{" ++ showArgs opts False (map FValue (MS.toList s)) ++ "}"-ppValues opts (Set s) -    | S.size s == 0 = "{}"-    | otherwise =  "{" ++ showArgs opts False (map FValue (S.toList s)) ++ "}"-ppValues _ (String s)        = show s-ppValues opts (Thunk f)      = "thunk(" ++ ppFuncons opts f ++ ")"-ppValues opts EmptyTuple     = "()"-ppValues opts (NonEmptyTuple v1 v2 vs)   = showArgs opts True (map FValue (v1:v2:vs))-ppValues opts (Vector v) = showFn opts "vector" (map FValue (V.toList v))-ppValues opts (ComputationType ct) = ppComputationTypes opts ct--ppComputationTypes :: RunOptions -> ComputationTypes -> String-ppComputationTypes opts (Type t) = ppTypes opts t-ppComputationTypes opts (ComputesType ty) = "=>" ++ ppTypes opts ty-ppComputationTypes opts (ComputesFromType s t) = ppTypes opts s ++ "=>" ++ ppTypes opts t--ppTypes :: RunOptions -> Types -> String-ppTypes _ Atoms                     = "atoms"-ppTypes _ AsciiCharacters           = "ascii-characters"-ppTypes _ (BoundedIntegers m n)     = "bounded-integers(" ++ show m ++ ","++ show n ++ ")"-ppTypes _ ComputationTypes          = "computation-types"-ppTypes _ EmptyType                 = "empty-type"-ppTypes _ (UnicodeCharacters)       = "unicode-characters"-ppTypes _ (Integers)                = "integers"-ppTypes _ (Strings)                 = "strings"-ppTypes _ (Values)                  = "values"-ppTypes opts (Maps x y)             = showFn opts "maps" [type_ x, type_ y]-ppTypes _ Types                     = "types"-ppTypes _ ADTs                      = "algebraic-datatypes"-ppTypes opts (ADT nm ts)            = unpack nm ++ showArgs opts True (map (type_) ts)-ppTypes _ (Bits n)                  = "bits(" ++ show n ++ ")"-ppTypes _ (IEEEFloats format)       = "ieee-floats(" ++ show format ++ ")"-ppTypes opts (Lists ty)             = "lists(" ++ ppTypes opts ty ++ ")"-ppTypes opts (Multisets ty)         = showFn opts "multisets" [type_ ty]-ppTypes opts Naturals               = "naturals"-ppTypes opts Rationals              = "rationals"-ppTypes opts (Thunks ct)            = "thunks(" ++ ppComputationTypes opts ct ++ ")"-ppTypes opts (Sets ty)              = "sets(" ++ ppTypes opts ty ++ ")"-ppTypes opts (Vectors ty)           = "vectors(" ++ ppTypes opts ty ++ ")"-ppTypes opts (Tuples tys)           = "tuples(" ++ intercalate "," (map op tys) ++ ")"-    where op (ty, Nothing) = ppTypes opts ty-          op (ty, Just op) = ppTypes opts ty ++ ppOp op-ppTypes opts (Union ty1 ty2)        = "(" ++ ppTypes opts ty1 ++ "|" ++ ppTypes opts ty2 ++")"--ppOp :: SeqSortOp -> String-ppOp StarOp = "*"-ppOp PlusOp = "+"-ppOp QuestionMarkOp = "?"--{--ppTerms :: FTerm -> String -ppTerms (TApp nm ts) = unpack nm ++ ppTerms ts-ppTerms (TName nm)   = unpack nm-ppTerms (TVar var)   = var-ppTerms (TTuple ts)  = "(" ++ intercalate "," (map ppTerms ts) ++ ")"-ppTerms (TList ts)   = "[" ++ intercalate "," (map ppTerms ts) ++ "]"-ppTerms (TSet ts)    = "{" ++ intercalate "," (map ppTerms ts) ++ "}"-ppTerms (TMap ts)    = "map" ++ (ppTerms (TTuple ts))-ppTerms (TSortSeq term op) = ppTerms term ++ ppOp op-ppTerms (TSortUnion t1 t2) = ppTerms t1 ++ "|" ++ show t2-ppTerms (TSortComputes to) = "=>" ++ ppTerms to-ppTerms (TSortComputesFrom from to) = ppTerms from ++ "=>" ++ ppTerms to-ppTerms (TFuncon f)  = ppFuncons defaultRunOptions f--}+ppFuncons opts (FApp nm fs)     = unpack nm ++ showArgs opts True fs   -- helpers @@ -150,4 +84,23 @@ showArgs opts b args | b         = "(" ++ seq ++ ")"                      | otherwise = seq  where seq = intercalate "," (map (ppFuncons opts) args)++ppTerms :: RunOptions -> FTerm -> String+ppTerms opts (TApp "list" ts)   = "[" ++ intercalate "," (map (ppTerms opts) ts) ++ "]"+ppTerms opts (TApp nm ts) = unpack nm ++ "(" ++ intercalate "," (map (ppTerms opts) ts) ++ ")"+ppTerms opts (TName nm)   = unpack nm+ppTerms opts (TVar var)   = var+ppTerms opts (TSeq ts)    = "(" ++ intercalate "," (map (ppTerms opts) ts) ++ ")"+ppTerms opts (TSet ts)    = "{" ++ intercalate "," (map (ppTerms opts) ts) ++ "}"+ppTerms opts (TMap ts)    = "map" ++ ("(" ++ intercalate "," (map (ppTerms opts) ts) ++ ")")+ppTerms opts (TSortSeq term op) = ppTerms opts term ++ ppOp op+ppTerms opts (TSortPower t1 t2) = ppTerms opts t1 ++ "^" ++ ppTerms opts t2+ppTerms opts (TSortUnion t1 t2) = ppTerms opts t1 ++ "|" ++ show t2+ppTerms opts (TSortInter t1 t2) = ppTerms opts t1 ++ "&" ++ show t2+ppTerms opts (TSortComplement t1) = "~(" ++ ppTerms opts t1 ++ ")"+ppTerms opts (TSortComputes to) = "=>" ++ ppTerms opts to+ppTerms opts (TSortComputesFrom from to) = ppTerms opts from ++ "=>" ++ ppTerms opts to+ppTerms opts (TFuncon f)  = ppFuncons opts f+ppTerms opts TAny         = "_"+
src/Funcons/RunOptions.hs view
@@ -1,17 +1,16 @@-{-# LANGUAGE OverloadedStrings, TupleSections #-}+{-# LANGUAGE OverloadedStrings, TupleSections, FlexibleContexts #-}  module Funcons.RunOptions where  import Funcons.Types-import Funcons.Parser+import Funcons.GLLParser (Parser(..), pFunconsSeq, pFuncons, fct_lexerSettings)+import Funcons.Parser (fct_parse) -import Text.ParserCombinators.Parsec-import qualified Text.ParserCombinators.Parsec.Token as P-import qualified Text.ParserCombinators.Parsec.Language as L +import GLL.Combinators hiding (chooses)  import qualified Data.Map as M import Control.Monad (when)-import Data.Char (isSpace)+import Control.Compose (OO(..)) import Data.Text (pack) import Data.List (isSuffixOf, isPrefixOf) import Data.List.Split (splitOn)@@ -20,13 +19,13 @@  type GeneralOptions = M.Map Name String type BuiltinFunconsOptions = M.Map Name Funcons-type TestOptions = M.Map Name Funcons+type TestOptions = M.Map Name [Funcons] type InputValues = M.Map Name [Values]  data RunOptions = RunOptions {             mfuncon_term        :: Maybe Funcons-        ,   general_opts        :: GeneralOptions -        ,   builtin_funcons     :: BuiltinFunconsOptions +        ,   general_opts        :: GeneralOptions+        ,   builtin_funcons     :: BuiltinFunconsOptions         ,   expected_outcomes   :: TestOptions         ,   given_inputs        :: InputValues         }@@ -42,18 +41,18 @@     (given_inputs opts `M.union` given_inputs opts')  funcon_term :: RunOptions -> Funcons-funcon_term = maybe err id . mfuncon_term  +funcon_term = maybe err id . mfuncon_term     where err = error "Please give a .fct file as an argument or use the --funcon-term flag"  bool_opt_default :: Bool -> Name -> M.Map Name String -> Bool bool_opt_default def nm m = case M.lookup nm m of-    Nothing         -> def +    Nothing         -> def     Just "false"    -> False     _               -> True   bool_opt :: Name -> M.Map Name String -> Bool-bool_opt nm m = bool_opt_default False nm m +bool_opt nm m = bool_opt_default False nm m  do_refocus :: RunOptions -> Bool do_refocus opts = bool_opt "refocus" (general_opts opts)@@ -68,12 +67,12 @@ pp_full_environments = bool_opt "full-environments" . general_opts  show_result :: RunOptions -> Bool-show_result opts = if bool_opt "hide-result" (general_opts opts) +show_result opts = if bool_opt "hide-result" (general_opts opts)     then False     else not (interactive_mode opts)  show_counts :: RunOptions -> Bool-show_counts opts = if bool_opt "display-steps" (general_opts opts) +show_counts opts = if bool_opt "display-steps" (general_opts opts)     then not (interactive_mode opts)     else False @@ -87,12 +86,11 @@ hide_input = maybe [] (map pack . splitOn ",") . M.lookup "hide-input-entity"  . general_opts  hide_control :: RunOptions -> [Name]-hide_control = maybe [] (map pack . splitOn ",") . M.lookup "hide-control-entity" . general_opts +hide_control = maybe [] (map pack . splitOn ",") . M.lookup "hide-control-entity" . general_opts  interactive_mode :: RunOptions -> Bool-interactive_mode opts = if bool_opt "interactive-mode" (general_opts opts)-    then M.null (inputValues opts) -    else False+interactive_mode opts = +  M.null (inputValues opts) && bool_opt "interactive-mode" (general_opts opts)  pp_string_outputs :: RunOptions -> Bool pp_string_outputs = bool_opt "format-string-outputs" . general_opts@@ -101,7 +99,7 @@ string_inputs = bool_opt "string-inputs" . general_opts  show_tests :: RunOptions -> Bool-show_tests opts = if bool_opt "hide-tests" (general_opts opts) +show_tests opts = if bool_opt "hide-tests" (general_opts opts)         then False         else M.size (expected_outcomes opts) > 0 @@ -113,55 +111,65 @@ auto_config :: RunOptions -> Bool auto_config opts = bool_opt_default True "auto-config" (general_opts opts) -inputValues :: RunOptions -> InputValues +csv_output :: RunOptions -> Bool+csv_output opts = if bool_opt "csv" (general_opts opts)+                    then True+                    else csv_output_with_keys opts++csv_output_with_keys :: RunOptions -> Bool+csv_output_with_keys opts = bool_opt "csv-keys" (general_opts opts)++inputValues :: RunOptions -> InputValues inputValues = given_inputs -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"]+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_ = map ("--" ++) booleanOptions  stringOptions = ["display-mutable-entity", "hide-output-entity"     , "hide-control-entity", "hide-input-entity", "max-restarts"] stringOptions_ = map ("--" ++) stringOptions -allOptions = "funcon-term" : booleanOptions ++ stringOptions +allOptions = "funcon-term" : booleanOptions ++ stringOptions allOptions_ = "--funcon-term" : booleanOptions_ ++ stringOptions_-    + run_options :: [String] -> IO (RunOptions, [String]) run_options = fold (defaultRunOptions, [])  where  fold (opts,errors) (arg:args)-            | arg `elem` booleanOptions_ = -                let (val, rest) -                        | not (null args) +            | arg `elem` booleanOptions_ =+                let (val, rest)+                        | not (null args)                         , not (isPrefixOf "--" (head args)) = (head args, tail args)                         | otherwise = ("true", args)                     opts' = opts {general_opts = M.insert (pack (tail (tail arg)))                                     val (general_opts opts)}                 in fold (opts',errors) rest             | arg `elem` stringOptions_ && length args > 0 =-                let opts' = opts {general_opts = M.insert (pack (tail (tail arg))) +                let opts' = opts {general_opts = M.insert (pack (tail (tail arg)))                                     (head args) (general_opts opts)}                 in fold (opts', errors) (tail args)             | arg == "--funcon-term" &&  length args > 0 =-                let opts' = opts {mfuncon_term = Just (read (head args))}+                let opts' = opts {mfuncon_term = Just (fct_parse (head args))}                 in fold (opts', errors) (tail args)             | isSuffixOf ".fct" arg = do                 fct <- readFile arg                 let cfg_name = take (length arg - 4) arg ++ ".config"                 exists <- doesFileExist cfg_name-                opts' <- if exists && auto_config opts -                            then readFile cfg_name >>= +                opts' <- if exists && auto_config opts+                            then readFile cfg_name >>=                                     return . flip (parseAndApplyConfig cfg_name) opts-                            else return opts -                let opts'' = opts' {mfuncon_term = Just (read fct)}+                            else return opts+                let opts'' = opts' {mfuncon_term = Just (fct_parse fct)}                 fold (opts'', errors) args             | isSuffixOf ".config" arg = fold (opts, errors) ("--config":arg:args)             | arg == "--config" && length args > 0 = do                 let cfg_name = head args                 exists <- doesFileExist cfg_name                 when (not exists) (error ("config file not found: " ++ cfg_name))-                str <- readFile cfg_name +                str <- readFile cfg_name                 let opts' = parseAndApplyConfig cfg_name str opts                 fold (opts', errors) (tail args)             | otherwise = do@@ -171,86 +179,87 @@         fold (opts, errors) [] = return (opts, errors)  parseAndApplyConfig :: FilePath -> String -> RunOptions -> RunOptions-parseAndApplyConfig fp str = optionsOverride (parser pRunOptions fp str)+parseAndApplyConfig fp str = optionsOverride (config_parser str) +-- gll config parser+config_parser :: String -> RunOptions+config_parser string = case GLL.Combinators.parseWithOptions [maximumPivot,throwErrors] pRunOptions+                             (Funcons.RunOptions.lexer string) of+  []      -> error "no parse (config)"+  (c:_)   -> c++lexer :: String -> [Token]+lexer = GLL.Combinators.lexer cfg_lexerSettings++cfg_lexerSettings = fct_lexerSettings {+      keywords = (keywords fct_lexerSettings) ++ cfg_keywords+  ,   keychars = (keychars fct_lexerSettings) ++ cfg_keychars+  }++cfg_keychars = ":;="+cfg_keywords = allOptions ++ ["result-term", "general", "tests", "funcons", "inputs"]+ pRunOptions :: Parser RunOptions-pRunOptions = foldr optionsOverride defaultRunOptions <$> -                    many (choice [  keyword "general" *> braces pGeneral-                                 ,  keyword "funcons" *> braces pBuiltinFuncons-                                 ,  keyword "tests" *> braces pTestOutcomes-                                 ,  keyword "inputs" *> braces pInputValues ] )- where  runOptions :: Maybe RunOptions -> Maybe BuiltinFunconsOptions -> -                        Maybe TestOptions -> RunOptions-        runOptions mopts mbin mtests = let opts = maybe defaultRunOptions id mopts-                in opts { builtin_funcons = maybe M.empty id mbin-                        , expected_outcomes = maybe M.empty id mtests }+pRunOptions = "SPECS"+  <:=> foldr optionsOverride defaultRunOptions <$$> multiple pSpec +pSpec :: Parser RunOptions+pSpec = "SPEC"+  <:=> keyword "general" **> braces pGeneral+  <||> keyword "tests" **> braces pTestOutcomes+  <||> keyword "funcons" **> braces pBuiltinFuncons+  <||> keyword "inputs" **> braces pInputValues+ pGeneral :: Parser RunOptions-pGeneral = toOpts <$> -                (optionMaybe (keyword "funcon-term" *> colon *> pFuncons <* semiColon))-            <*> (M.fromList <$> many pKeyValues)+pGeneral = "GENERAL"+  <:=> toOpts <$$> --TODO uncomfortable usage of id+        optional (id <$$ keyword "funcon-term" <** keychar ':' <**> pFuncons <** keychar ';')+          <**> (M.fromList <$$> multiple pKeyValues)  where toOpts mf gen = defaultRunOptions {mfuncon_term = mf, general_opts = gen}-       pKeyValues = pBoolOpts <|> pStringOpts-        where   pBoolOpts = choice (map pKeyValue booleanOptions)-                 where pKeyValue key = (pack key,) . maybe "true" id -                            <$ keyword key <*> optionMaybe (colon *> pBool) <* semiColon-                    -                pStringOpts = choice (map pKeyValue stringOptions)-                 where pKeyValue key = (pack key,) <$ keyword key <* colon <*> pStringValue <* semiColon+       pKeyValues = "GENERAL-KEYVALUES" <:=> pBoolOpts <||> pStringOpts+        where   pBoolOpts = "GENERAL-BOOLS" `chooses` (map pKeyValue booleanOptions)+                 where pKeyValue key = (pack key,) . maybe "true" id+                            <$$ keyword key <**> optional (keychar ':' **> pBool)+                                  <** keychar ';' +                pStringOpts = "GENERAL-STRINGS" `chooses` (map pKeyValue stringOptions)+                 where pKeyValue key = (pack key,) <$$ keyword key <** keychar ':'+                                          <**> pStringValue <** keychar ';'++chooses p alts = (<::=>) p (OO alts)+ pBool :: Parser String-pBool = string "true" <|> string "false"+pBool = "BOOL-VALUE" <:=> id_lit -- everything except `false` is considered `true`  pStringValue :: Parser String-pStringValue = filter (not . isSpace) . concat <$> commaSep1 stringValue-    where stringValue = many1 (choice [alphaNum, char '-'])--pFunconName = many1 (choice [alphaNum, char '-'])- -pFunconTerm :: Parser Funcons-pFunconTerm = pFuncons+pStringValue = "STRING-VALUE" <:=> id_lit <||> string_lit -pBuiltinFuncons :: Parser RunOptions-pBuiltinFuncons = (\list -> defaultRunOptions {builtin_funcons = M.fromList list}) <$> -    many ((,) . pack <$> pFunconName <* equals <*> pFunconTerm <* semiColon)+pFunconName :: Parser String+pFunconName = "FUNCON-NAME" <:=> id_lit  pTestOutcomes :: Parser RunOptions-pTestOutcomes = toOptions <$> (M.union <$> pResult <*> pEntityValues)-    where pResult = mStoreResult <$> optionMaybe (id <$ keyword "result-term" <* colon -                                        <*> pFunconTerm <* semiColon)+pTestOutcomes = "TEST-OUTCOMES"+  <:=> toOptions <$$> (M.union <$$> pResult <**> pEntityValues)+    where pResult = mStoreResult <$$>+                      optional (id <$$ keyword "result-term" <** keychar ':'+                                             <**> pFunconsSeq <** keychar ';')             where mStoreResult Nothing = M.empty                   mStoreResult (Just f) = M.singleton "result-term" f-          pEntityValues = M.fromList <$>    -            many (((,) . pack <$> pFunconName <* colon <*> pFunconTerm <* semiColon))+          pEntityValues = "TEST-ENTITIES" <:=> M.fromList <$$> multiple+              ((,) . pack <$$> pFunconName <** keychar ':' <**> pFunconsSeq <** keychar ';')           toOptions map = defaultRunOptions { expected_outcomes = map } -pInputValues :: Parser RunOptions -pInputValues = (\list -> defaultRunOptions { given_inputs = M.fromList list}) <$>-    many (toPair <$> pFunconName <* colon <*> pFunconTerm <* semiColon) -    where toPair nm f = case recursiveFunconValue f of -                Just (List vs)  -> (pack nm, vs)-                _               -> error ("inputs for " ++ nm ++ " not a list")---- simple lexer-languageDef = L.emptyDef {-                    P.identStart = lower-                ,   P.identLetter = lower <|> oneOf "-"-                ,   P.reservedNames = allOptions ++ ["result-term"]-                ,   P.reservedOpNames = [":"]-                ,   P.commentLine = "--"-                }--language = P.makeTokenParser languageDef--equals = whitespace *> char '=' <* whitespace-colon = whitespace *> char ':' <* whitespace-semiColon = whitespace *> char ';' <* whitespace+pBuiltinFuncons :: Parser RunOptions+pBuiltinFuncons = "BUILTIN-FUNCONS"+  <:=> insertFuncons <$$> multiple ((,) . pack <$$> pFunconName <** keychar '='+                            <**> pFuncons <** keychar ';')+ where insertFuncons list = defaultRunOptions {builtin_funcons = M.fromList list} -whitespace = P.whiteSpace language-comma = P.comma language-keyword = P.reserved language-braces = P.braces language-identifier = P.identifier language-stringLiteral = P.stringLiteral language-commaSep1 = P.commaSep1 language-semiSep = P.semiSep language+pInputValues :: Parser RunOptions+pInputValues = "INPUT-VALUES"+  <:=> insertInputs <$$> multiple (toPair <$$> pFunconName <** keychar ':'+                                  <**> pFunconsSeq <** keychar ';')+  where insertInputs list = defaultRunOptions { given_inputs = M.fromList list }+        toPair nm fs = case sequence (map recursiveFunconValue fs) of+                        Just vs -> (pack nm, vs)+                        _       -> error ("inputs for " ++ nm ++ " not a list")
src/Funcons/Simulation.hs view
@@ -1,19 +1,21 @@-{-# LANGUAGE TupleSections, FlexibleInstances, OverloadedStrings #-}+{-# LANGUAGE TupleSections, FlexibleInstances, OverloadedStrings,TypeSynonymInstances #-}  module Funcons.Simulation where  import Funcons.Types import Funcons.Exceptions import Funcons.Printer+import Funcons.Parser (fvalue_parse) import Funcons.RunOptions +import Control.Applicative import Control.Monad.State import System.IO (hFlush,stdout) import qualified Data.Map as M import Data.Text (unpack)  class Monad m => Interactive m where-    fread    :: Bool -> Name -> m Values --entity name+    fread    :: Bool -> Name {- entity name -} -> m Funcons     fprint   :: Name -> Values -> m ()     fexec    :: m a -> InputValues -> IO (a, InputValues) @@ -23,24 +25,28 @@     fread str_inp nm = (case nm of         "standard-in" -> putStr "\n> " >> hFlush stdout         _ -> putStrLn ("Please provide input for " ++ unpack nm ++ ":"))-                >> getLine >>= return . toValue-        where   toValue str | str_inp   = String str-                            | otherwise = read str+                >> getLine >>= return . toFuncon+        where   toFuncon  str | str_inp   = string_ str+                              | otherwise = fvalue_parse str -    fprint _ (String s)     = putStr s-    fprint _ v              = putStr (showValues v)+    fprint _ v | isString_ v  = putStr (unString v)+               | otherwise    = putStr (showValues v)  type SimIO = State InputValues +runSimIO :: SimIO a -> InputValues -> (a, InputValues)+runSimIO = runState   instance Interactive SimIO where     fexec ma defs = return (runState ma defs)          fread _ nm = do v <- gets mLookup -                    modify (M.adjust tail nm)+                    modify (M.adjust mTail nm)                     return v         where mLookup m = case M.lookup nm m of-                  Just (v:_) -> v-                  _ -> error ("simulated IO: " ++ show (InsufficientInput nm))+                  Just (v:_)  -> FValue v+                  _           -> FValue none__ +              mTail []     = []+              mTail (_:vs) = vs      -- SimIO ignores prints as simulated Output is always done     -- alternative is to use tell from Writer monad here and somehow remember
src/Funcons/Substitution.hs view
@@ -1,14 +1,17 @@ {-# LANGUAGE LambdaCase #-}  module Funcons.Substitution (-    Env(..), subsAndRewrite, envInsert, emptyEnv, Levelled(..), substitute,-    rewriteTermTo, stepTermTo,+    Env(..), subsAndRewritesInEnv, subsAndRewritesToValueInEnv, subsAndRewritesToValue, subsAndRewritesToValuesInEnv, subsAndRewritesToValues,+    envInsert, emptyEnv,+    Levelled(..), substitute_signal, substitute,rewriteTermTo, stepTermTo,+    envRewrite, envStore, lifted_envRewrite, lifted_envStore, +    fLevel, fsLevel, vLevel, vsLevel, envLookup     ) where  import Funcons.Types import Funcons.MSOS-import Funcons.Exceptions +import Control.Applicative import Control.Monad import Data.Monoid import qualified Data.Map as M@@ -17,9 +20,11 @@ -- This environment is used by a substitution procedure to transform -- funcon terms from 'FTerm' representation to 'Funcons'. type Env = M.Map MetaVar Levelled -data Levelled   = ValueTerm Values+data Levelled   = TypeTerm ComputationTypes+                | TypesTerm [ComputationTypes]+                | ValueTerm Values                 | ValuesTerm [Values]-                | FunconTerm Funcons+                | FunconTerm Funcons (Maybe (MSOS StepRes)) {- cached step -}                 | FunconsTerm [Funcons]  -- | The empty substitution environment.@@ -28,73 +33,207 @@  envLookup :: Env -> MetaVar -> Rewrite Levelled envLookup env k = case M.lookup k env of-                    Nothing -> internal ("undefined metavar: " <> k)+                    Nothing -> internal ("no substitution for variable: " <> k)                     Just lf -> return lf  envInsert :: MetaVar -> Levelled -> Env -> Env-envInsert = M.insert+envInsert = M.insertWith op+  where op new old = new --TODO somehow unify values+  {- +        isWildCard (ValueTerm VAny) = True+        isWildCard (ValuesTerm [VAny]) = True+        isWildCard (FunconTerm (FValue VAny) _) = True+        isWildCard (FunconsTerm [FValue VAny]) = True+        isWildCard _ = False+  -}+         +{-+tsLevel :: Levelled -> Rewrite [ComputationTypes]+tsLevel = \case TypesTerm ts  -> return ts+                TypeTerm t    -> return [t]+                ValuesTerm vs +                  | all isSort_ vs -> return $ map downcastSort (map FValue vs)+                  | otherwise     -> internal "not bound to types"+                ValueTerm v | isSort_ v-> return $ [downcastSort v]+-}++vsLevel :: Levelled -> Rewrite [Values]+vsLevel = \case FunconsTerm fs +                  | all (not.hasStep) fs  -> return (map downcastValue fs)+                  | otherwise           -> internal "not bound to values"+                FunconTerm (FValue v) _ -> return [v]+                FunconTerm f         _  -> internal ("not bound to values")  +                ValuesTerm vs           -> return vs+                ValueTerm v             -> return [v]+                TypeTerm t              -> return [ComputationType t]+                TypesTerm ts            -> return (map ComputationType ts)++vLevel :: Levelled -> Rewrite Values+vLevel =  \case FunconsTerm [FValue v]  -> return v+                FunconsTerm fs          -> internal "not bound to values"+                FunconTerm (FValue v) _ -> return v+                FunconTerm f         _  -> internal ("not bound to value")  +                ValuesTerm [v]          -> return v+                ValuesTerm vs           -> internal ("not bound to value")  +                ValueTerm v             -> return v+                TypeTerm t              -> return (ComputationType t)+                TypesTerm [t]           -> return (ComputationType t)+                TypesTerm _             -> internal "not bound to a value"+ fsLevel :: Levelled -> Rewrite [Funcons] fsLevel = \case FunconsTerm f       -> return f-                FunconTerm f        -> return [f]+                FunconTerm f _      -> return [f]                 ValuesTerm vs       -> return (map FValue vs)                 ValueTerm v         -> return [FValue v]--fLevel k = \case    FunconsTerm [f]  -> return f-                    FunconsTerm fs -                     | all isVal fs    -> return (FValue $ safe_tuple_val (map downcastValue fs))-                     | otherwise       -> return (FTuple fs)-                    FunconTerm f        -> return f-                    ValuesTerm vs       -> return (FValue (safe_tuple_val vs))-                    ValueTerm v         -> return (FValue v)+                TypesTerm ts        -> return (map sort_ ts)+                TypeTerm t          -> return [sort_ t] +fLevel k = \case    +  FunconsTerm [f]   -> return f+  FunconsTerm fs    -> internal "not bound to a funcon"+  FunconTerm f _    -> return f+  ValuesTerm [v]    -> return (FValue v)+  ValuesTerm vs     -> internal "not bound to a funcon" +  ValueTerm v       -> return (FValue v)+  TypeTerm t        -> return (sort_ t)+  TypesTerm [t]     -> return (sort_ t)+  TypesTerm ts      -> internal "not bound to a funcon"  -- substitution++substitute_signal :: FTerm -> Env -> Rewrite Values+substitute_signal t env = case t of+  TVar k        -> vLevel $ envMaybeLookup env k+  TName nm      -> return (ADTVal nm [])+  TApp nm terms -> ADTVal nm . map FValue  <$> subs_flatten terms env+  TSeq ts       -> internal "top level sequence during substitution (signal)" +--  TList ts      -> List <$> subs_flatten ts env+  TSet ts       -> setval_ <$> subs_flatten ts env+  TMap ts       -> mapval_ <$> subs_flatten ts env+  TFuncon (FValue v) -> return v+  TAny          -> return VAny+  _             -> internal "missing case in substitute_signal"+  where subs_flatten :: [FTerm] -> Env -> Rewrite [Values]+        subs_flatten terms env = (concat <$>) $ forM terms $ \case+              TVar k  -> vsLevel $ envMaybeLookup env k+              TSeq ts -> mapM (flip substitute_signal env) ts+              term    -> (:[]) <$> substitute_signal term env++        envMaybeLookup :: Env -> MetaVar -> Levelled+        envMaybeLookup env k = case M.lookup k env of+                            Nothing -> ValueTerm VAny+                            Just lf -> lf++ substitute :: FTerm ->  Env -> Rewrite Funcons substitute (TVar k) env = envLookup env k >>= fLevel k substitute (TName nm) env = return $ FName nm-substitute (TApp nm term) env = do-    -- if its anything but a sequence-var or a tuple, make it a singleton sequence-    fs <- case term of TVar k   -> envLookup env k >>= fsLevel-                       TTuple l -> substitute term env >>= \case-                                    FTuple fs -> return fs  -                                    _ -> error "subsitute assert"-                       _        -> (:[]) <$> substitute term env-    return $ FApp nm (FTuple fs)-substitute (TTuple terms) env = FTuple <$> subsFlatten terms env +substitute (TApp nm terms) env = FApp nm <$> subsFlatten terms env+substitute (TSeq terms) env = internal ("top level sequence during substitution: " ++ show terms) -- e.g. print(V+:values+) -- standard-out![V+] -> ()-substitute (TList terms) env = FList <$> subsFlatten terms env -substitute (TSet terms)  env  = FSet <$> subsFlatten terms env-substitute (TMap terms)  env  = FMap <$> mapM (flip substitute env) terms+--substitute (TList terms) env = FList <$> subsFlatten terms env +substitute (TSet terms)  env = FSet <$> subsFlatten terms env+substitute (TMap terms)  env = FMap <$> subsFlatten terms env substitute (TFuncon f) env = return f substitute (TSortUnion t1 t2) env = FSortUnion <$> substitute t1 env <*> substitute t2 env+substitute (TSortInter t1 t2) env = FSortInter <$> substitute t1 env <*> substitute t2 env+substitute (TSortComplement t1) env = FSortComplement <$> substitute t1 env substitute (TSortSeq t1 op) env = flip FSortSeq op <$> substitute t1 env+substitute (TSortPower t1 t2) env = FSortPower <$> substitute t1 env <*> substitute t2 env substitute (TSortComputes t1) env = FSortComputes <$> substitute t1 env substitute (TSortComputesFrom t1 t2) env =      FSortComputesFrom <$> substitute t1 env <*> substitute t2 env+substitute TAny env = internal "missing substitution (wildcard)"  -- flatten out sequence-variables subsFlatten :: [FTerm] -> Env -> Rewrite [Funcons] subsFlatten terms env = concat <$> (forM terms $ \case                              TVar k  -> envLookup env k >>= fsLevel+                            TSeq ts -> mapM (flip substitute env) ts                             term    -> (:[]) <$> substitute term env) -subsAndRewrite :: FTerm -> Env -> Rewrite Values-subsAndRewrite term env = do-    f <- substitute term env -    rewriteFuncons f >>= \case-        ValTerm v -> return v-        CompTerm _ _    -> rewrite_throw (SideCondFail "premise evaluation requires step")+-- Version of subsAndRewritesToValue that 'caches' computational steps:+-- If after rewriting a computational step is produced the+--  step and associated funcon replace the term in the environment+--  (if the term consists of just a meta-variable)+-- This function immediately returns a computational step when+--  a given term has a cached step+-- If the term is not just a meta-variable, this function behaves normally+subsAndRewritesInEnv :: FTerm -> Env -> Rewrite (Rewritten, Env)+subsAndRewritesInEnv (TVar x) env +  | Just (FunconTerm f (Just step)) <- M.lookup x env = +      return $ (CompTerm f step, env)+subsAndRewritesInEnv term env  = do +  f <- substitute term env+  res <- rewriteFunconsWcount f+  case term of +    TVar x -> case res of +     ValTerm vs       -> return (res, envInsert x (ValuesTerm vs) env)+     CompTerm f step  -> return (res, envInsert x (FunconTerm f (Just step)) env)+    _      -> return (res, env) +subsAndRewritesToValue :: FTerm -> Env -> Rewrite Values+subsAndRewritesToValue f env = fst <$> subsAndRewritesToValueInEnv f env +-- Important optimisation:+-- If the given term is a var, +--    update the env to store the rewritten value.+subsAndRewritesToValueInEnv :: FTerm -> Env -> Rewrite (Values, Env)+subsAndRewritesToValueInEnv (TVar x) env +  -- assumed to be already rewritten (because cached step is present)+  | Just (FunconTerm f (Just step)) <- M.lookup x env = rewriteToValErr+subsAndRewritesToValueInEnv term env = do+  f <- substitute term env +  v <- rewritesToValue f+  case term of TVar var  -> return (v, envInsert var (ValueTerm v) env)+               _         -> return (v, env)++subsAndRewritesToValues :: FTerm -> Env -> Rewrite [Values]+subsAndRewritesToValues f env = fst <$> subsAndRewritesToValuesInEnv f env++subsAndRewritesToValuesInEnv :: FTerm -> Env -> Rewrite ([Values], Env)+subsAndRewritesToValuesInEnv (TVar x) env +  -- assumed to be already rewritten (because cached step is present)+  | Just (FunconTerm f (Just step)) <- M.lookup x env = rewriteToValErr+subsAndRewritesToValuesInEnv term env = do+  fs  <- subsFlatten [term] env +  vs  <- concat <$> mapM rewritesToValues fs+  case term of TVar var  -> return (vs, envInsert var (ValuesTerm vs) env)+               _         -> return (vs, env)++ -- | Variant of 'rewriteTo' that applies substitution. rewriteTermTo :: FTerm -> Env -> Rewrite Rewritten-rewriteTermTo fterm env = substitute fterm env >>= rewriteTo+rewriteTermTo fterm env = subsFlatten [fterm] env >>= \case+  [f] -> rewriteTo f+  fs  -> rewriteSeqTo fs   -- | Variant of 'stepTo' that applies substitution.-stepTermTo :: FTerm -> Env -> MSOS Funcons-stepTermTo fterm env = do   -    (liftRewrite $ substitute fterm env) >>= stepTo+stepTermTo :: FTerm -> Env -> MSOS StepRes +stepTermTo fterm env = liftRewrite (subsFlatten [fterm] env) >>= \case +  [f] -> stepTo f+  fs  -> stepSeqTo fs +lifted_envStore :: MetaVar -> FTerm -> Env -> MSOS Env+lifted_envStore m t e = liftRewrite (envStore m t e)++envStore :: MetaVar -> FTerm -> Env -> Rewrite Env+envStore var term env = substitute term env >>= \case+    (FValue v)    -> return $ envInsert var (ValueTerm v) env+    fct           -> return $ envInsert var (FunconTerm fct Nothing) env++lifted_envRewrite :: MetaVar -> Env -> MSOS Env+lifted_envRewrite m e = liftRewrite (envRewrite m e)++-- | Apply as many rewrites as possible to the term bound to the+-- given variable in the meta-environment+envRewrite :: MetaVar -> Env -> Rewrite Env+envRewrite var env = do+    envLookup env var >>= \case+      FunconTerm fct Nothing -> rewriteFunconsWcount fct >>= \case+        ValTerm vs    -> return $ envInsert var (ValuesTerm vs) env+        CompTerm f fs -> return $ envInsert var (FunconTerm f (Just fs)) env+      _ -> return env
src/Funcons/Tools.hs view
@@ -6,14 +6,15 @@     -- $moduledoc     mkMain, mkMainWithLibrary, mkMainWithLibraryEntities,     mkMainWithLibraryTypes, mkMainWithLibraryEntitiesTypes,+    mkFullyFreshInterpreter, mkFreshInterpreter,     -- * Creating embedded interpreters.-    run, runWithExtensions,+    run, runWithExtensions, runWithExtensionsNoCore, runWithExtensionsNoNothing,     -- * Utility functions for interpreter extensions.      -- ** Funcon libraries.-    FunconLibrary, libEmpty, libUnion, libUnions, libFromList,+    FunconLibrary, libEmpty, libUnion, libOverride, libUnions, libOverrides, libFromList,     -- ** Type environments.-    TypeEnv, DataTypeMembers(..), DataTypeAlt(..), TypeParam, -        emptyTypeEnv, typeEnvUnion, typeEnvUnions, typeEnvFromList,+    TypeRelation, DataTypeMembers(..), DataTypeAltt(..), TypeParam, +        emptyTypeRelation, typeEnvUnion, typeEnvUnions, typeEnvFromList,     -- ** Entity declarations      EntityDefaults, EntityDefault(..), noEntityDefaults,     ) where@@ -32,7 +33,7 @@ import Data.Text (unpack) import Data.List ((\\), intercalate) import qualified Data.Map as M-import Control.Monad (forM_, when, unless)+import Control.Monad (forM_, when, unless,join)  -- | The empty collection of entity defaults. noEntityDefaults :: [EntityDefault]@@ -55,41 +56,69 @@ -- argument. mkMainWithLibraryEntities :: FunconLibrary -> EntityDefaults -> IO () mkMainWithLibraryEntities lib ents = -    mkMainWithLibraryEntitiesTypes lib ents emptyTypeEnv+    mkMainWithLibraryEntitiesTypes lib ents emptyTypeRelation  -- | Creates a /main/ function for the interpreter obtained by extending -- the main interpreter with the funcons in the 'FunconLibrary' argument--- and with a 'TypeEnv' mapping datatypes to their constructors and+-- and with a 'TypeRelation' mapping datatypes to their constructors and -- type arguments.-mkMainWithLibraryTypes :: FunconLibrary -> TypeEnv -> IO ()+mkMainWithLibraryTypes :: FunconLibrary -> TypeRelation -> IO () mkMainWithLibraryTypes lib tys = mkMainWithLibraryEntitiesTypes lib [] tys  -- | Creates a /main/ function for the interpreter obtained by extending--- the main interpreter with funcons, 'EntityDefaults' and a 'TypeEnv'. -mkMainWithLibraryEntitiesTypes :: FunconLibrary -> EntityDefaults -> TypeEnv -> IO ()+-- the main interpreter with funcons, 'EntityDefaults' and a 'TypeRelation'. +mkMainWithLibraryEntitiesTypes :: FunconLibrary -> EntityDefaults -> TypeRelation -> IO () mkMainWithLibraryEntitiesTypes lib defaults tyenv = do        args <- getArgs-    case args of-        []      -> go0-        _       -> go2 args- where  go0 = putStrLn "Please provide me with an .fct file"-        go2 args = runWithExtensions lib defaults tyenv args Nothing +    runWithExtensions lib defaults tyenv args Nothing +-- | Creates a /main/ function for the interpreter aware of only+-- the given 'FunconLibrary', 'EntityDefaults' and 'TypeRelation'. +mkFullyFreshInterpreter :: FunconLibrary -> EntityDefaults -> TypeRelation -> IO ()+mkFullyFreshInterpreter lib defaults tyenv = do   +    args <- getArgs+    runWithExtensionsNoNothing lib defaults tyenv args Nothing ++-- | Creates a /main/ function for the interpreter aware of only+-- the given 'FunconLibrary', 'EntityDefaults' and 'TypeRelation',+-- and the built-in types and operations. +mkFreshInterpreter :: FunconLibrary -> EntityDefaults -> TypeRelation -> IO ()+mkFreshInterpreter lib defaults tyenv = do   +    args <- getArgs+    runWithExtensionsNoCore lib defaults tyenv args Nothing + -- | Same as 'run', except receiving additional interpreter extensions as arguments. -- Useful when a translation to 'Funcons' has been implemented in Haskell as -- well as 'Funcons', entities or datatypes specific to the object language.+-- Includes the 'Funcons.Core' funcons. runWithExtensions :: -    FunconLibrary -> EntityDefaults -> TypeEnv -> [String] -> Maybe Funcons -> IO ()+    FunconLibrary -> EntityDefaults -> TypeRelation -> [String] -> Maybe Funcons -> IO () runWithExtensions lib defaults tyenv = -    emulate full_lib full_defaults full_tyenv - where-        full_lib = libUnions [lib+  runWithExtensionsNoCore +    (libUnions [Funcons.Core.Library.funcons, lib]) +    (concat [defaults, Funcons.Core.Library.entities])+    (typeEnvUnions [tyenv, Funcons.Core.Library.types])++-- | Same as 'run', except receiving additional interpreter extensions as arguments.+-- Useful when a translation to 'Funcons' has been implemented in Haskell as+-- well as 'Funcons', entities or datatypes specific to the object language.+-- Does not include the 'Funcons.Core' funcons.+runWithExtensionsNoCore :: +    FunconLibrary -> EntityDefaults -> TypeRelation -> [String] -> Maybe Funcons -> IO ()+runWithExtensionsNoCore lib defaults tyenv = runWithExtensionsNoNothing full_lib defaults tyenv+ where  full_lib = libUnions [lib                              ,Funcons.EDSL.library-                             ,Funcons.Core.Manual.library-                             ,Funcons.Core.Library.funcons]-        full_defaults = concat [defaults, Funcons.Core.Library.entities]-        full_tyenv = typeEnvUnions [tyenv, Funcons.Core.Library.types]+                             ,Funcons.Core.Manual.library] +-- | Same as 'run', except receiving additional interpreter extensions as arguments.+-- Useful when a translation to 'Funcons' has been implemented in Haskell as+-- well as 'Funcons', entities or datatypes specific to the object language.+-- Does not include the 'Funcons.Core' funcons.+runWithExtensionsNoNothing :: +    FunconLibrary -> EntityDefaults -> TypeRelation -> [String] -> Maybe Funcons -> IO ()+runWithExtensionsNoNothing lib defaults tyenv = emulate lib defaults tyenv ++ -- |  -- Creates a main function by passing in a list of command line arguments  -- and an optional initial 'Funcons' to execute. The 'Funcons' argument is optional@@ -97,7 +126,7 @@ -- file that specifies an initial 'Funcons' term. -- Useful when a translation to 'Funcons' has been implemented in Haskell. run :: [String] -> Maybe Funcons -> IO ()-run = runWithExtensions libEmpty [] emptyTypeEnv +run = runWithExtensions libEmpty [] emptyTypeRelation   ------------------------------------------------------------------------------ --- running programs @@ -106,54 +135,58 @@     forM_ unknown_opts $ \arg -> do         putStrLn ("unknown option: " ++ arg)     case interactive_mode opts of -        True    -> emulate' (fread (string_inputs opts) :: Name -> IO Values) lib defaults tyenv opts mf0-        False   -> emulate' (fread (string_inputs opts) :: Name -> SimIO Values) lib defaults tyenv opts mf0+        True    -> emulate' (fread (string_inputs opts) :: Name -> IO Funcons) lib defaults tyenv opts mf0+        False   -> emulate' (fread (string_inputs opts) :: Name -> SimIO Funcons) lib defaults tyenv opts mf0 -emulate' :: Interactive m => (Name -> m Values) -> -            FunconLibrary -> EntityDefaults -> TypeEnv -> RunOptions -> Maybe Funcons -> IO ()-emulate' reader lib defaults tyenv opts mf0 = do +emulate' :: Interactive m => (Name -> m Funcons) ->+            FunconLibrary -> EntityDefaults -> TypeRelation -> RunOptions -> Maybe Funcons -> IO ()+emulate' reader lib defaults tyenv opts mf0 = do     -- the initial funcon term must be either given from a .fct file (Maybe Funcons)     -- or specified in a configuration file-    let f0 = maybe (funcon_term opts) id mf0  -        msos_ctxt = MSOSReader (RewriteReader lib tyenv opts f0 f0) emptyINH+    let f0 = maybe (funcon_term opts) id mf0+        msos_ctxt = MSOSReader (RewriteReader lib tyenv opts f0 f0) emptyINH emptyDCTRL reader     -- run the Interactive monad, returning in the evaluation results + entity values.     -- if in --interactive-mode the Interactive monad will be IO      --  and all the desired output will already have been printed to the screen     ((e_exc_f, mut, wr), rem_ins) <- -        fexec (runMSOS (setEntityDefaults defaults (stepTrans opts 0 f0))+        fexec (runMSOS (setEntityDefaults defaults (stepTrans opts 0 (toStepRes f0)))                 msos_ctxt (emptyMSOSState {inp_es = inputs})) (inputValues opts)     -- if not in --interactive-mode then print additional information based on flags-    unless (interactive_mode opts) +    unless (interactive_mode opts)         (withResults defaults msos_ctxt e_exc_f mut wr rem_ins)- where inputs = foldr op M.empty defaults-                where   op (DefInput nm) = M.insert nm ([], Just (reader nm))-                        op _             = id+ where inputs = M.foldrWithKey op M.empty (inputValues opts)+                where   op nm _ = M.insert nm ([], Just (reader nm))  withResults defaults msos_ctxt e_exc_f msos_state wr rem_ins-        | show_tests opts = +        | show_tests opts =             case e_exc_f of              Left ie -> putStrLn (showIException ie)-             Right f -> printTestResults f defaults msos_ctxt msos_state wr rem_ins+             Right efvs -> printTestResults (either (:[]) (map FValue) efvs)+                              defaults msos_ctxt msos_state wr rem_ins         | otherwise = do     unless (show_output_only opts) $ do         printCounts -        case e_exc_f of +        case e_exc_f of             Left ie -> putStrLn (showIException ie)-            Right f -> printResult f+            Right f -> printResult (either (:[]) (map FValue) f)         printMutable         printControl-        printInputOutput rem_ins (hide_input opts)+        printInput rem_ins (hide_input opts)     printOutput  where     muts = mut_entities msos_state      opts = run_opts (ereader msos_ctxt)     printResult f = when (show_result opts) $ do                         putStrLn "Result:"-                        putStrLn (ppFuncons opts f)+                        putStrLn (ppFunconsSeq opts f)                         putStrLn "" -    printCounts = when (show_counts opts) -                    (putStrLn $ show (counters (ewriter wr)))+    printCounts = do+      when (show_counts opts) $ do +        when (csv_output_with_keys opts) (putStrLn counterKeys) +        if (csv_output opts) +          then putStrLn $ displayCounters (counters (ewriter wr))+          else putStrLn $ ppCounters (counters (ewriter wr))      printMutable = forM_ toShow display      where toShow = show_mutable opts@@ -177,36 +210,36 @@                     unless (show_output_only opts)                          (putStrLn ("Output Entity: " ++ unpack name))                     case all isString_ vs && pp_string_outputs opts of-                        True    -> mapM_ (\(String s) -> putStr s) vs-                        False   -> putStrLn (displayValue (List vs))+                        True    -> mapM_ (putStr . unString) vs+                        False   -> putStrLn (displayValues vs)                     unless (show_output_only opts) (putStrLn "")             where vs = out M.! name            toHide = hide_output opts  -    printInputOutput ios toHide = forM_ (M.keys ios \\ toHide) display+    printInput ios toHide = forM_ (M.keys ios \\ toHide) display      where display name = unless (null vs) $ do -                            putStrLn ("Output Entity: " ++ unpack name)-                            putStrLn (displayValue (List vs))+                            putStrLn ("Input Entity: " ++ unpack name)+                            putStrLn (displayValues vs)                             putStrLn ""             where vs = ios M.! name +    displayValues vs = intercalate "," (map displayValue vs)     displayValue (Map m) = intercalate "\n"                                     [ displayValue key ++ " |-> " ++ displayValue val                                     | (key, val) <- M.assocs m ]-    displayValue (ADTVal "variable" [Atom a, ComputationType (Type t)]) = -        "variable(" ++ displayValue (Atom a) ++ ", " ++ ppTypes opts t ++ ")"+    displayValue (ADTVal "variable" [FValue (Atom a)+                                     ,FValue (ComputationType (Type t))]) = +        "variable(" ++ displayValue (Atom a) ++ ", " ++ ppTypes (ppFuncons opts) t ++ ")"     displayValue (Atom a) = "@" ++ a-    displayValue (List vs) | all isString_ vs = concatMap displayValue vs-    displayValue (ADTVal con vs) = unpack con ++"("++ intercalate "," (map displayValue vs)++")"-    displayValue val = ppValues opts val+    displayValue val = ppValues (ppFuncons opts) val -printTestResults :: Funcons -> EntityDefaults -> MSOSReader -> +printTestResults :: [Funcons] -> EntityDefaults -> MSOSReader m ->                          MSOSState m -> MSOSWriter -> InputValues -> IO ()-printTestResults f defaults msos_ctxt msos_state wr rem_ins = do+printTestResults fs defaults msos_ctxt msos_state wr rem_ins = do         forM_ (M.keys opts) printNotExists         when (M.member "result-term" opts) $-            unless (result_term == f) (reportError "result-term" result_term f)+            unless (result_term == fs) (reportError "result-term" (showFunconsSeq result_term) (showFunconsSeq fs))         printMutable         printControl         printInputOutput out@@ -218,25 +251,27 @@             localEval name term = case runRewrite (rewriteFuncons term) eval_ctxt eval_state                 of  (Left ie,_,_) -> error ("internal exception in " ++ unpack name                                      ++ " evaluation:\n" ++ showIException ie)-                    (Right (ValTerm v),_,_) -> v+                    (Right (ValTerm [v]),_,_) -> v+                    (Right (ValTerm vs),_,_) -> error +                      ("evaluation of " ++ unpack name ++ " results in sequence")                     (Right _,_,_) ->                          error ("evaluation of " ++ unpack name ++ " requires step")                  mLocalEval term = case runRewrite(rewriteFuncons term) eval_ctxt eval_state of-                (Right (ValTerm v),_,_) -> Just v+                (Right (ValTerm [v]),_,_) -> Just v                 _                         -> Nothing -            result_term = case recursiveFunconValue rf of-                Nothing -> case mLocalEval rf of+            result_term = case sequence (fmap recursiveFunconValue rf) of+                Nothing -> case sequence (fmap mLocalEval rf) of                                 Nothing -> rf-                                Just v  -> FValue v-                Just v  -> FValue v+                                Just vs -> map FValue vs+                Just vs -> map FValue vs              where rf = (opts M.! "result-term")             opts = expected_outcomes (run_opts eval_ctxt)              reportError name expected actual = do-                putStrLn ("expected " ++ unpack name ++ ": " ++ show expected)-                putStrLn ("actual   " ++ unpack name ++ ": " ++ show actual)+                putStrLn ("expected " ++ unpack name ++ ": " ++ expected)+                putStrLn ("actual   " ++ unpack name ++ ": " ++ actual)              printNotExists "result-term" = return ()             printNotExists name = @@ -249,10 +284,12 @@             printMutable = forM_ (M.assocs muts) (uncurry display)              where display name val = case M.lookup name opts of                         Nothing -> return ()-                        Just expected -> unless (localEval name expected == val) -                                            (reportError name expected val)+                        Just expected -> unless +                                            (map (localEval name) expected == [val]) +                                            (reportError name (show $ map showFuncons expected) (showValues val))              -- set default values of output and control entities+            ctrl :: M.Map Name (Maybe Values)             ctrl = foldr op (ctrl_entities wr) defaults              where  op (DefControl name) ctrl                          | not (M.member name ctrl) = M.insert name Nothing ctrl@@ -266,30 +303,32 @@             -- TODO this does not test the case that a control signal is expected              --      according to the test, but not present.             printControl = forM_ (M.assocs ctrl) (uncurry display)-             where  -- test whether control signal is expected when there is none+             where  display :: Name -> Maybe Values -> IO ()+                    -- test whether control signal is expected when there is none                     -- shows expected signal                      display name Nothing = case M.lookup name opts of                          Nothing -> return ()-                        Just val -> putStrLn ("expected "++unpack name++": "-                                        ++ show (localEval name val))+                        Just vals -> putStrLn ("expected "++unpack name++": "+                                        ++ show (map (showValues . localEval name) vals))                     -- test whether control signal is expected when there is one                     -- shows that the emitted signal was unexpected                     -- if a signal was expected, shows if actual and expected are unequal                     display name (Just val) = case M.lookup name opts of-                        Nothing -> putStrLn ("unexpected " ++ unpack name ++ ": " ++ show val)-                        Just expected -> unless (localEval name expected == val) -                                            (reportError name expected val)+                        Nothing -> putStrLn ("unexpected " ++ unpack name ++ ": " ++ showValues val)+                        Just expected -> unless +                                            (map (localEval name) expected == [val]) +                                            (reportError name (show $ map showFuncons expected) (showValues val))              printInputOutput remaining = forM_ (M.assocs remaining) (uncurry display)              where  -- no test-error if the input/output is empty                      -- (and no input/output was specified)                     display name [] | Nothing <- M.lookup name opts = return ()                     display name vals = case M.lookup name opts of-                        Nothing -> putStrLn ("unexpected " ++ unpack name ++ ": " ++ show vals)-                        Just expected -> case localEval name expected of -                            List exps -> unless (exps == vals) (reportError name expected vals)+                        Nothing -> putStrLn ("unexpected " ++ unpack name ++ ": " ++ show (map showValues vals))+                        Just expected -> case map (localEval name) expected of +                            [ADTVal "list" exps] -> unless (exps == map FValue vals) (reportError name (show $ map showFuncons exps) (show $ map showValues vals))                             val -> error ("non-list given as expected output entity ("++-                                        unpack name ++ "): " ++ show val)+                                        unpack name ++ "): " ++ show (map showValues val))                       -- $moduledoc@@ -448,7 +487,7 @@ --    a 'FunconLibrary' is a "funcon module". --    An interpreter is obtained by importing the chosen "funcon modules" and uniting  --    their 'FunconLibrary's (with 'libUnions'), perhaps together with default---    values for entities ('EntityDefault') and information about custom datatypes ('TypeEnv').+--    values for entities ('EntityDefault') and information about custom datatypes ('TypeRelation'). --    The resulting maps are given as arguments to 'mkMainWithLibraryEntitiesTypes' --    (or variant). --    By using 'mkMainWithLibraryEntitiesTypes', all interpreters inherit the
+ src/Funcons/TypeSubstitution.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE OverloadedStrings #-}++module Funcons.TypeSubstitution where++import Funcons.Types+import Funcons.Patterns++import qualified Data.Map as M+import qualified Data.Set as S++-- | Associates types (Terms) with meta-variables +type TypeEnv = M.Map MetaVar TyAssoc+data TyAssoc = ElemOf FTerm | SubTyOf FTerm++-- | Version of `subsTypeVar` that does not replace the meta-variables+-- in the given set+limitedSubsTypeVar :: HasTypeVar a => S.Set MetaVar -> TypeEnv -> a -> a+limitedSubsTypeVar pvars env = subsTypeVar (foldr aux env pvars)+  where aux pvar = M.delete pvar++-- | Version of `subsTypeVarWildcard` that does not replace the meta-variables+-- in the given set+limitedSubsTypeVarWildcard :: HasTypeVar a => S.Set MetaVar -> Maybe FTerm -> TypeEnv -> a -> a+limitedSubsTypeVarWildcard pvars mt env = subsTypeVarWildcard mt (foldr aux env pvars)+  where aux pvar = M.delete pvar+++-- | Used for replacing meta-variables `T` in pattern annotations `P:T` with+-- the type to which `T` is bound in some type-environment (if any)+class HasTypeVar a where+  subsTypeVar :: TypeEnv -> a -> a+  subsTypeVar = subsTypeVarWildcard Nothing++  subsTypeVarWildcard :: (Maybe FTerm) -> TypeEnv -> a -> a++instance HasTypeVar FTerm where+  subsTypeVarWildcard mt env t = case t of +    TVar var -> case M.lookup var env of+                  Just (SubTyOf ty)   -> ty+                  Just (ElemOf (TSortSeq (TName "types") op)) -> TSortSeq (TName "values") op+                  Just (ElemOf (TSortSeq (TName "value-types") op)) -> TSortSeq (TName "values") op+                  Just (ElemOf (TName "types")) -> TName "values"+                  Just (ElemOf vt)  -> TVar var+                  Nothing           -> TVar var+    TName nm -> TName nm+    TApp nm ts-> TApp nm (map (subsTypeVarWildcard mt env) ts)+    TSeq ts -> TSeq (map (subsTypeVarWildcard mt env) ts)+--    TList ts  -> TList (map (subsTypeVarWildcard mt env) ts)+    TSet  ts  -> TSet (map (subsTypeVarWildcard mt env) ts)+    TMap ts   -> TMap (map (subsTypeVarWildcard mt env) ts)+    TFuncon f -> TFuncon f+    TSortSeq t op -> TSortSeq (subsTypeVarWildcard mt env t) op+    TSortPower t1 t2 -> TSortPower (subsTypeVarWildcard mt env t1) (subsTypeVarWildcard mt env t2)+    TSortUnion t1 t2 -> TSortUnion (subsTypeVarWildcard mt env t1) (subsTypeVarWildcard mt env t2)+    TSortInter t1 t2 -> TSortInter (subsTypeVarWildcard mt env t1) (subsTypeVarWildcard mt env t2)+    TSortComplement t -> TSortComplement (subsTypeVarWildcard mt env t)+    TSortComputes t -> TSortComputes (subsTypeVarWildcard mt env t)+    TSortComputesFrom f t -> TSortComputesFrom (subsTypeVarWildcard mt env f) (subsTypeVarWildcard mt env t)+    TAny -> case mt of  Nothing -> TAny+                        Just t  -> t++instance HasTypeVar VPattern where+  subsTypeVarWildcard mt env pat = case pat of +    VPAnnotated p   t -> VPAnnotated (subsTypeVarWildcard mt env p) (subsTypeVarWildcard mt env t)+    PADT n pats       -> PADT n (map (subsTypeVarWildcard mt env) pats)+--    PList pats        -> PList (map (subsTypeVarWildcard mt env) pats)+    VPMetaVar var     -> VPMetaVar var+    VPSeqVar var op   -> VPSeqVar var op+    VPLit v           -> VPLit v+    VPWildCard        -> VPWildCard+    VPType pat        -> VPType pat ++instance HasTypeVar FPattern where+  subsTypeVarWildcard mt env pat = case pat of+    PAnnotated p t  -> PAnnotated (subsTypeVarWildcard mt env p) (subsTypeVarWildcard mt env t)+    PValue p        -> PValue $ subsTypeVarWildcard mt env p+    PMetaVar var    -> PMetaVar var+    PSeqVar var op  -> PSeqVar var op+    PWildCard       -> PWildCard++
src/Funcons/Types.hs view
@@ -1,37 +1,44 @@-{-# LANGUAGE OverloadedStrings, TupleSections #-}+{-# LANGUAGE OverloadedStrings, TupleSections, FlexibleInstances #-} -module Funcons.Types where+module Funcons.Types (+  module Funcons.Types,+  module VAL,) where +import qualified Funcons.Operations as VAL hiding (SortErr, ValueOp)+import Funcons.Operations hiding (Name, Values, ComputationTypes, TaggedSyntax, Types, isMap, isAscii, isNoValue, isSet, map_empty_, isEnv, isDefinedVal, isString_, isChar, isVec, isType, isList, isNat, isInt, atoms_, integers_, values_, set_, list_, tuple_, atom_, nothing_, defined_values_, types_, value_types_, toList, isList)++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 qualified Data.BitVector as BV import Data.Text (Text)-import Data.Maybe (isJust) import Data.Ratio  type MetaVar = String type Name = Text --- | +-- | -- Internal representation of funcon terms. -- The generic constructors 'FName' and 'FApp' use names to represent--- nullary funcons and applications of funcons to other terms. +-- nullary funcons and applications of funcons to other terms. -- Funcon terms are easily created using 'applyFuncon' or via -- the smart constructors exported by "Funcons.Core". data Funcons    = FName Name-                | FApp Name Funcons-                | FTuple [Funcons]-                | FList [Funcons]+                | FApp Name [Funcons]+--                | FTuple [Funcons]+--                | FList [Funcons]                 | FSet [Funcons]                 | FMap [Funcons]                 | FValue Values-                | FSortSeq Funcons SeqSortOp+                | FSortSeq Funcons VAL.SeqSortOp+                | FSortPower Funcons Funcons {- evals to natural number -}                 | FSortUnion Funcons Funcons+                | FSortInter Funcons Funcons+                | FSortComplement Funcons                 | FSortComputes Funcons-                | FSortComputesFrom Funcons Funcons-                deriving (Eq, Ord, Show)+                | FSortComputesFrom Funcons Funcons +                deriving (Eq, Ord, Show, Read)  -- | -- Build funcon terms by applying a funcon name to `zero or more' funcon terms.@@ -45,108 +52,59 @@ -- > handle_thrown_ :: Funcons -> Funcons -> Funcons -- > handle_thrown_ x y = applyFuncon "handle-thrown" [x,y] applyFuncon :: Name -> [Funcons] -> Funcons-applyFuncon str args    | null args = FName str-                        | otherwise = FApp str (FTuple args)+applyFuncon str args | null args = FName str+                     | otherwise = FApp str args +tuple_ :: [Funcons] -> Funcons+tuple_ = FValue . ADTVal "list"+ -- | Creates a list of funcon terms. list_ :: [Funcons] -> Funcons-list_ = FList+list_ = applyFuncon "list"   -- | Creates a set of funcon terms. set_ :: [Funcons] -> Funcons-set_ = FSet-+set_ = applyFuncon "set" --- | Funcon term representation identical to 'Funcons', --- but with meta-variables. +-- | Funcon term representation identical to 'Funcons',+-- but with meta-variables. data FTerm  = TVar MetaVar             | TName Name-            | TApp Name FTerm-            | TTuple [FTerm]-            | TList [FTerm]+            | TApp Name [FTerm]+            | TSeq [FTerm] -- a sequence of terms, consumed during substitution+--            | TList [FTerm]             | TSet  [FTerm]             | TMap  [FTerm]             | TFuncon Funcons-            | TSortSeq FTerm SeqSortOp+            | TSortSeq FTerm VAL.SeqSortOp+            | TSortPower FTerm FTerm {- should eval to a natural number -}             | TSortUnion FTerm FTerm+            | TSortInter FTerm FTerm  +            | TSortComplement FTerm             | TSortComputes FTerm             | TSortComputesFrom FTerm FTerm-            deriving (Eq, Ord, Show)+            | TAny -- used whenever funcon terms may have holes in them+                   -- currently only the case in "downwards" flowing signals+            deriving (Eq, Ord, Show, Read) --- | --- This datatype provides a number of builtin value types. --- Composite values are only built up out of other values.--- The only exception is 'Thunk' which stores a thunked computation--- (funcon term).-data Values     = ADTVal Name [Values]-                | Ascii Int-                | Atom String-                | Bit BV.BitVector-                | Char Char-                | ComputationType ComputationTypes-                | Float Float-                | IEEE_Float_32 Float-                | IEEE_Float_64 Double-                | Int Integer-                | List [Values]-                | Map Map-                | Multiset (MS.MultiSet Values)-                | Nat Integer-                | Rational Rational-                | Set Set-                | String String-                | Thunk Funcons-                | EmptyTuple -- | Tuples are split in 'EmptyTuple' and 'NonEmptyTuple' to avoid singleton tuples. Tuples should be constructed by applications of 'tuple_'. -                | NonEmptyTuple Values Values [Values]-                | Vector Vectors-        deriving (Eq,Ord,Show) +type Values = VAL.Values Funcons+type TaggedSyntax = VAL.TaggedSyntax Funcons++instance HasValues Funcons where+  inject = FValue+  project f = case f of+    FValue v  -> Just v+    _         -> Nothing+ type Map        = M.Map Values Values type Set        = S.Set Values type Vectors    = V.Vector Values --- | Postfix operators for specifying sequences.-data SeqSortOp = StarOp | PlusOp | QuestionMarkOp-                deriving (Show, Eq, Ord)---- | Computation type /S=>T/ reflects a type of term--- whose given value is of type /S/ and result is of type /T/.-data ComputationTypes = Type Types -- | /=>T/-                      | ComputesType Types -- | /S=>T/-                      | ComputesFromType Types Types-                      deriving (Ord,Eq,Show)- -- | Representation of builtin types.-data Types  = ADTs-            | ADT Name [Types]-            | AsciiCharacters-            | Atoms-            | Bits Int-            | BoundedIntegers Integer Integer-            | ComputationTypes-            | EmptyType-            | IEEEFloats IEEEFormats-            | Integers-            | Lists Types-            | Maps Types Types-            | Multisets Types-            | Naturals-            | Rationals-            | Sets Types-            | Strings-            | Thunks ComputationTypes -- | Types optionally attached to 'SeqSortOp'.-            | Tuples [TTParam]-            | Types-            | UnicodeCharacters-            | Union Types Types-            | Values-            | Vectors Types-              deriving (Ord,Eq,Show)--type TTParam = (Types,Maybe SeqSortOp)--data IEEEFormats = Binary32 | Binary64-        deriving (Enum,Show,Eq,Ord)+type ComputationTypes = VAL.ComputationTypes Funcons+type Types   = VAL.Types Funcons+type TTParam = (Types,Maybe VAL.SeqSortOp)  binary32 :: Values binary32 = ADTVal "binary32" []@@ -154,111 +112,48 @@ binary64 :: Values binary64 = ADTVal "binary64" [] -adtval :: Name -> Values -> Values-adtval nm = ADTVal nm . tuple_unval+adtval :: Name -> [Values] -> Values+adtval nm = ADTVal nm . map FValue +tuple_val__ :: [Values] -> Values+tuple_val__ = adtval "tuple"+tuple_val_ = FValue . tuple_val__+ nullaryTypes :: [(Name,Types)] nullaryTypes =   [ ("algebraic-datatypes", ADTs)+  , ("adts"               , ADTs)+  , ("non-grounded-values", Complement GroundValues)   , ("atoms",               Atoms)-  , ("computation-types",   ComputationTypes)   , ("empty-type",          EmptyType)-  , ("integers",            Integers)-  , ("naturals",            Naturals)+--  , ("naturals",            Naturals)+--  , ("nats",                Naturals)   , ("rationals",           Rationals)-  , ("strings",             Strings)-  , ("types",               Types)   , ("unicode-characters",  UnicodeCharacters)-  , ("values",              Values)+  , ("values",              VAL.Values)   ]  unaryTypes :: [(Name,Types->Types)] unaryTypes =-  [ ("lists",     Lists)-  , ("multisets", Multisets)-  , ("sets",      Sets)-  , ("vectors",   Vectors)+  [ ("multisets", Multisets)+--  , ("lists",     Lists)+--  , ("vectors",   Vectors)   ]  binaryTypes :: [(Name,Types->Types->Types)] binaryTypes =-  [ ("maps", Maps)-  ]+  [] -boundedIntegerTypes :: [(Name, Integer -> Integer -> Types)]-boundedIntegerTypes = [("bounded-integers", BoundedIntegers)]+boundedIntegerTypes :: [(Name, Integer -> Types)]+boundedIntegerTypes = [("integers-from", IntegersFrom)+                      ,("from", IntegersFrom)+                      ,("integers-up-to", IntegersUpTo)+                      ,("up-to", IntegersUpTo)+                      ]  floatTypes :: [(Name, IEEEFormats -> Types)] floatTypes = [("ieee-floats", IEEEFloats)] -bitsTypes :: [(Name, Int -> Types)]-bitsTypes = [("bits", Bits)]---- type environment---- | The typing environment maps datatype names to their definitions.-type TypeEnv = M.Map Name DataTypeMembers---- | A type parameter is of the form X:T where the name of the parameter,/X/, is optional.--- When present, /X/ can be used to specify the type of constructors.-type TypeParam = (Maybe MetaVar,FTerm)--- | A datatype has `zero or more' type parameters and--- `zero or more' alternatives.-data DataTypeMembers = DataTypeMembers [TypeParam] [DataTypeAlt]---- | An alternative is either a datatype constructor or the inclusion--- of some other type. The types are arbitrary funcon terms (with possible--- variables) that may require evaluation to be resolved to a 'Types'.-data DataTypeAlt = DataTypeInclusion FTerm-                 | DataTypeConstructor Name FTerm---- | Lookup the definition of a datatype in the typing environment.-typeLookup :: Name -> TypeEnv -> Maybe DataTypeMembers-typeLookup = M.lookup---- | The empty 'TypeEnv'.-emptyTypeEnv :: TypeEnv-emptyTypeEnv = M.empty---- | Unites a list of 'TypeEnv's.-typeEnvUnions :: [TypeEnv] -> TypeEnv-typeEnvUnions = foldr typeEnvUnion emptyTypeEnv---- | Unites two 'TypeEnv's.-typeEnvUnion :: TypeEnv -> TypeEnv -> TypeEnv-typeEnvUnion = M.unionWith (\_ _ -> error "duplicate type-name")---- | Creates a `TypeEnv' from a list.-typeEnvFromList :: [(Name, DataTypeMembers)] -> TypeEnv-typeEnvFromList = M.fromList--{---- I think this is no longer needed.--- Ids-newtype ID = ID' Values-    deriving (Eq)--instance Ord ID where-    (ID' v1) `compare` (ID' v2) = idCompare v1 v2--idCompare :: Values -> Values -> Ordering-(Int i1)    `idCompare` (Int i2)     = compare i1 i2-(Int _)     `idCompare` _            = LT-_           `idCompare` (Int _)     = GT-(String s)  `idCompare` (String s2) = compare s s2-_           `idCompare` _           = error "comparing non-atomic ids"--}---- Values should be atoms: Ints,Booleans,Strings,Tuples? etc---- Ids are just `strings` now.-{--id_ :: Funcons -> Funcons-id_ (FValue v@(Int _))    = FValue (ID (ID' v))-id_ (FValue v@(String _)) = FValue (ID (ID' v))-id_ v = error $ "id supplied with non-atomic value"--}- --- smart constructors for values  -- | Creates an integer 'literal'.@@ -266,26 +161,28 @@ int_ = FValue . mk_integers . toInteger  -- | Creates a natural 'literal'.-nat_ :: Int -> Funcons +nat_ :: Int -> Funcons nat_ i | i < 0      = int_ i        | otherwise  = FValue $ mk_naturals $ toInteger i --- | Creates an atom from a 'String'. +-- | Creates an atom from a 'String'. atom_ :: String -> Funcons atom_ = FValue . Atom --- | Creates a rational literal.-rational_ :: Rational -> Funcons-rational_ = FValue . mk_rationals- -- | Creates a string literal. string_ :: String -> Funcons-string_ = FValue . String+string_ = FValue . string__+string__ :: String -> Values+string__ = ADTVal "list" . map (FValue . Ascii) --- | Creates an empty tuple as a 'Values'.-empty_tuple_ :: Funcons -empty_tuple_ = FValue EmptyTuple+float_ :: Double -> Funcons+float_ = FValue . Float +ieee_float_32_ :: Float -> Funcons+ieee_float_32_ = FValue . IEEE_Float_32+ieee_float_64_ :: Double -> Funcons+ieee_float_64_ = FValue . IEEE_Float_64+ -- | The empty map as a 'Funcons'. empty_map_,map_empty_ :: Funcons empty_map_ = FValue (Map M.empty)@@ -296,60 +193,50 @@ empty_set_ = FValue (Set S.empty)  -- | Creates a tuple of funcon terms.-tuple_ :: [Funcons] -> Funcons-tuple_ = FTuple--tuple_val_ :: [Values] -> Funcons-tuple_val_ = FValue . safe_tuple_val+--tuple_ :: [Funcons] -> Funcons+--tuple_ = FTuple  type_ :: Types -> Funcons type_ = FValue . typeVal +sort_ :: ComputationTypes -> Funcons+sort_ = FValue . ComputationType++comp_type_ :: ComputationTypes -> Funcons+comp_type_ = FValue . ComputationType + vec :: V.Vector (Values) -> Funcons vec = FValue . Vector +vec_ :: [Values] -> Funcons+vec_ = FValue . Vector . V.fromList -- idval :: Values -> Values -- idval = ID . ID'  typeVal :: Types -> Values typeVal = ComputationType . Type -safe_tuple_val :: [Values] -> Values-safe_tuple_val []         = EmptyTuple-safe_tuple_val [v]        = v-safe_tuple_val (v1:v2:vs) = NonEmptyTuple v1 v2 vs--tuple_unval :: Values -> [Values]-tuple_unval EmptyTuple               = []-tuple_unval (NonEmptyTuple v1 v2 vs) = v1:v2:vs-tuple_unval v                        = [v]--types_unval :: Types -> [Types]-types_unval (Tuples ts)-    | any (isJust . snd) ts = [Tuples ts]-    | otherwise             = map fst ts-types_unval t = [t]-- fvalues :: [Values] -> [Funcons] fvalues = map FValue  listval :: [Values] -> Funcons-listval = FValue . List+listval = FValue . ADTVal "list" . map FValue  setval :: [Values] -> Funcons setval = FValue . setval_ +setval_ :: [Values] -> Values setval_ = Set . S.fromList  mapval :: [Values] -> Funcons mapval = FValue . mapval_ -mapval_ = Map . M.fromList . map toKeyValue- where  toKeyValue (NonEmptyTuple k v []) = (k,v)-        toKeyValue _ = error "mapval"+mapval_ :: [Values] -> Values+mapval_ = Map . M.fromList . mkPairs   -- subtyping rationals++{- mk_rationals :: Rational -> Values mk_rationals r  | denominator r == 1 = mk_integers (numerator r)                 | otherwise             = Rational r@@ -361,129 +248,152 @@ mk_naturals :: Integer -> Values mk_naturals = Nat --- | Returns the /rational/ representation of a value if it is a subtype.--- Otherwise it returns the original value.-upcastRationals :: Values -> Values-upcastRationals (Nat n) = Rational (toRational n)-upcastRationals (Int i) = Rational (toRational i)-upcastRationals v       = v+mk_unicode_characters :: Char -> Values+mk_unicode_characters c  | C.isAscii c = mk_ascii_characters c+                         | otherwise   = Char c --- | Returns the /integer/ representation of a value if it is a subtype.--- Otherwise it returns the original value.-upcastIntegers :: Values -> Values-upcastIntegers (Nat n)  = Int n-upcastIntegers v        = v+-- TODO: haven't included `basic-characters` in the subtyping heirarchy yet. --- | Returns the /natural/ representation of a value if it is a subtype.--- Otherwise it returns the original value.-upcastNaturals :: Values -> Values-upcastNaturals v = v+mk_ascii_characters :: Char -> Values+mk_ascii_characters = Ascii+-}  -- | Returns the /unicode/ representation of an assci value. -- Otherwise it returns the original value.-upcastUnicode :: Values -> Values-upcastUnicode (Ascii c) = Char (toEnum c)-upcastUnicode v = v--castType :: Values -> Maybe Types-castType (ComputationType (Type ty)) = Just ty-castType EmptyTuple                  = Just (Tuples [])-castType (NonEmptyTuple t1 t2 ts)    = Tuples <$> mapM (fmap (,Nothing) . castType) (t1:t2:ts)-castType _                           = Nothing- --- Value specific  -- | Attempt to downcast a funcon term to a value.+downcastType :: Funcons -> Types +downcastType (FValue v) = downcastValueType v+downcastType _ = error "downcasting to sort failed"++downcastSort :: Funcons -> ComputationTypes +downcastSort (FValue (ComputationType s)) = s+downcastSort _ = error "downcasting to sort failed"+ downcastValue :: Funcons -> Values downcastValue (FValue v) = v downcastValue _ = error "downcasting to value failed" --- | Attempt to downcast a funcon term to a type.-downcastType :: Funcons -> Types-downcastType (FValue (ComputationType (Type ty))) = ty-downcastType _ = error "downcasting to type failed"---- | Attempt to downcast a value to a type.-downcastValueType :: Values -> Types-downcastValueType (ComputationType (Type t)) = t-downcastValueType _ = error "valueType: not a type"- recursiveFunconValue :: Funcons -> Maybe Values recursiveFunconValue (FValue v) = Just v-recursiveFunconValue (FList fs) = List <$> mapM recursiveFunconValue fs+--recursiveFunconValue (FList fs) = List <$> mapM recursiveFunconValue fs recursiveFunconValue (FSet fs)  = Set . S.fromList <$> mapM recursiveFunconValue fs-recursiveFunconValue (FMap fs)  = Map . M.fromList <$> mapM unFTuple fs- where  unFTuple (FTuple [k,v]) = (,) <$> recursiveFunconValue k <*> recursiveFunconValue v-        unFTuple _ = Nothing+recursiveFunconValue (FMap fs)  = Map . M.fromList . mkPairs <$> mapM recursiveFunconValue fs recursiveFunconValue _ = Nothing -(===) :: Values -> Values -> Bool-v1 === v2 = isGround v1 && isGround v2 && (v1 == v2)+allEqual :: [Values] -> [Values] -> Bool+allEqual xs ys = length xs == length ys && and (zipWith (===) xs ys) -(=/=) :: Values -> Values -> Bool-v1 =/= v2 = isGround v1 && isGround v2 && (v1 /= v2)+allUnEqual :: [Values] -> [Values] -> Bool+allUnEqual xs ys = length xs /= length ys || or (zipWith (=/=) xs ys) -isGround :: Values -> Bool-isGround (ADTVal _ mv)            = all isGround mv-isGround (Ascii _)                = True-isGround (Atom _)                 = True-isGround (Bit _)                  = True-isGround (Char _)                 = True-isGround (ComputationType _)      = True-isGround (EmptyTuple)             = True-isGround (Float _)                = True-isGround (IEEE_Float_32 _)        = True-isGround (IEEE_Float_64 _)        = True-isGround (Int _)                  = True-isGround (List vs)                = all isGround vs-isGround (Map m)                  = all isGround (M.elems m)-isGround (Multiset ms)            = all isGround ms-isGround (Nat _)                  = True-isGround (NonEmptyTuple v1 v2 vs) = all isGround (v1:v2:vs)-isGround (Rational _)             = True-isGround (Set s)                  = all isGround (S.toList s)-isGround (String _)               = True-isGround (Thunk _)                = False-isGround (Vector v)               = all isGround (V.toList v)+isNoValue :: Funcons -> Bool+isNoValue (FValue n) = n == none__+isNoValue _ = False +hasStep (FValue _) = False +hasStep _ = True+isVal (FValue _) = True+isVal _ = False+isDefinedVal f = isVal f && not (isNoValue f)+ -- functions that check simple properties of funcons--- TODO: these may not be needed any longer+-- TODO: Some of these are used, and all are exported by Funcons.EDSL+--       But are all of them still needed.  E.g isId doesn't seem very useful now that ids are just strings. isAscii (FValue (Ascii _))      = True isAscii _                       = False+isAscii_ (Ascii _)              = True+isAscii_ _                      = False+isString (FValue (ADTVal "list" s)) = all isAscii s+isString _                      = False+isString_ (ADTVal "list" s)     = all isAscii s+isString_ _                     = False isChar (FValue (Char _))         = True isChar _                        = False-isId = isString -- TODO: is this needed any more? isNat (FValue (Int _))          = True isNat _                         = False isInt (FValue (Int _))           = True isInt _                         = False-isList (FValue (List _))         = True+isList (FValue (ADTVal "list" _)) = True isList _                        = False isEnv f                         = isMap f isMap (FValue (Map _))           = True-isMap _                         = False+isMap _                          = False isSet (FValue (Set _))           = True isSet _                         = False-isString (FValue v)              = isString_ v-isString _                      = False-isString_ (String _)            = True-isString_ _                     = False-isThunk (FValue (Thunk _))       = True-isThunk _                       = False-isTup (FValue EmptyTuple)       = True-isTup (FValue (NonEmptyTuple _ _ _)) = True isTup _                         = False+isSort (FValue (ComputationType _)) = True+isSort _                        = False+isSort_ (ComputationType _) = True+isSort_ _                        = False isType (FValue (ComputationType (Type _))) = True isType _                        = False-isVal (FValue _)                 = True-isVal _                         = False isVec (FValue (Vector _))        = True isVec _                         = False-isType_ (ComputationType (Type _)) = True-isType_ _                       = False+isCharacter_ (Char _)           = True+isCharacter_ (Ascii _)          = True+isCharacter_ _                  = False -integers_,strings_,values_,unicode_characters_ :: Funcons+integers_,atoms_,values_,unicode_characters_ :: Funcons integers_ = type_ Integers unicode_characters_  = type_ UnicodeCharacters-strings_ = type_ Strings-values_ = type_ Values+values_ = type_ VAL.Values+defined_values_ = type_ DefinedValues+nothing_ = type_ Nothings+vectors_ :: Types -> Funcons+vectors_ = type_ . Vectors  +atoms_ = type_ Atoms++-- type environment++-- | The typing environment maps datatype names to their definitions.+type TypeRelation = M.Map Name DataTypeMembers++-- | A type parameter is of the form X:T where the name of the parameter,/X/, is optional.+-- When present, /X/ can be used to specify the type of constructors.+-- Variable /X/ be a sequence variable.+type TypeParam  = (Maybe MetaVar, Maybe VAL.SeqSortOp, FTerm)+data TPattern   = TPWildCard+                | TPVar MetaVar +                | TPSeqVar MetaVar VAL.SeqSortOp+                | TPLit FTerm {- should rewrite to a type -}+                | TPComputes TPattern+                | TPComputesFrom TPattern TPattern+                | TPADT Name [TPattern]+                deriving (Show, Eq, Ord, Read)++-- | A datatype has `zero or more' type parameters and+-- `zero or more' alternatives.+data DataTypeMembers = DataTypeMemberss Name [TPattern] [DataTypeAltt]+                     deriving (Show)++-- | An alternative is either a datatype constructor or the inclusion+-- of some other type. The types are arbitrary funcon terms (with possible+-- variables) that may require evaluation to be resolved to a 'Types'.+data DataTypeAltt = DataTypeInclusionn FTerm+                  | DataTypeMemberConstructor Name [FTerm] (Maybe [TPattern])+                  deriving (Show)++-- | Lookup the definition of a datatype in the typing environment.+typeLookup :: Name -> TypeRelation -> Maybe DataTypeMembers+typeLookup = M.lookup++-- | The empty 'TypeRelation'.+emptyTypeRelation :: TypeRelation+emptyTypeRelation = M.empty++-- | Unites a list of 'TypeRelation's.+typeEnvUnions :: [TypeRelation] -> TypeRelation+typeEnvUnions = foldr typeEnvUnion emptyTypeRelation++-- | Unites two 'TypeRelation's.+typeEnvUnion :: TypeRelation -> TypeRelation -> TypeRelation+typeEnvUnion = M.unionWith (\_ _ -> error "duplicate type-name")++-- | Creates a `TypeRelation' from a list.+typeEnvFromList :: [(Name, DataTypeMembers)] -> TypeRelation+typeEnvFromList = M.fromList+++
+ src/Funcons/ValueOperations.hs view
@@ -0,0 +1,32 @@++module Funcons.ValueOperations (+  execRewrites, evalOperation, +  IException(..), IE(..), isIn, +  ) where++import Funcons.EDSL (library)+import Funcons.Types+import Funcons.MSOS+import Funcons.Patterns (isIn)+import Funcons.Exceptions (IException(..), IE(..))+import Funcons.RunOptions+import Funcons.Core.Manual++evalOperation :: Funcons -> Either IE [Values]+evalOperation f =+  case execRewrites (rewriteFuncons f) of+    Left exc            -> Left exc+    Right (ValTerm vs)  -> Right vs+    Right _             -> error "rewriteToTerm: did you provide a value operation?"++execRewrites :: Rewrite a -> (Either IE a)+execRewrites rew = case e_exc_rewritten of+    Left (_, _, exc)  -> Left exc+    Right r           -> Right r+  where +    (e_exc_rewritten, _, _) = runRewrite rew reader state+    reader = RewriteReader (libUnions [Funcons.EDSL.library+                                      ,Funcons.Core.Manual.library])+                    emptyTypeRelation defaultRunOptions undefined undefined+    state  = RewriteState+