funcons-values 0.1.0.3 → 0.1.0.5

raw patch · 9 files changed

+78/−101 lines, 9 filesdep −random-stringsdep ~containersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: random-strings

Dependency ranges changed: containers

API changes (from Hackage documentation)

Files

• funcons-values.cabal +1/−2
• src/Funcons/Operations.hs +1/−1
• src/Funcons/Operations/Characters.hs +2/−2
• src/Funcons/Operations/Integers.hs +22/−0
• src/Funcons/Operations/Maps.hs +3/−6
• src/Funcons/Operations/Sets.hs +2/−4
• src/Funcons/Operations/Strings.hs +6/−4
• src/Funcons/Operations/Types.hs +13/−13
• src/Funcons/Operations/Values.hs +28/−69

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                funcons-values-version:             0.1.0.3+version:             0.1.0.5 synopsis:            Library providing values and operations on values in a fixed universe. description:              The PLanCompS project (<http://plancomps.org>) has developed a component-based approach to formal semantics.@@ -53,7 +53,6 @@                       ,bv >=0.5                       ,multiset >=0.3 && <0.4                       ,text >=1.2 && <1.3-                      ,random-strings   hs-source-dirs:      src   default-language:    Haskell2010   ghc-options:         -fwarn-incomplete-patterns -fwarn-monomorphism-restriction -fwarn-unused-imports

@@ -25,7 +25,7 @@  import Funcons.Operations.Expr  import Funcons.Operations.Libraries -import Funcons.Operations.Values hiding (showArgs, isGround, set_)+import Funcons.Operations.Values hiding (showArgs, set_) import Funcons.Operations.Eval hiding (showArgs) import Funcons.Operations.Atoms hiding (library) import qualified Funcons.Operations.Atoms (library)

@@ -29,8 +29,8 @@ ascii_character_ = unaryOp ascii_character  ascii_character :: HasValues t => OpExpr t -> OpExpr t ascii_character = vUnaryOp "ascii-character" op-  where op v | isString_ v, s <- unString v, length s == 1 -                = Normal $ inject $ Ascii $ head s+  where op v | isString_ v, [c] <- unString v+                = Normal $ inject $ Ascii c              | otherwise = SortErr "ascii-character not applied to a string (of 1 ascii character long)"  unicode_ :: HasValues t => [OpExpr t] -> OpExpr t

@@ -9,13 +9,20 @@ library :: HasValues t => Library t library = libFromList [     ("integers", NullaryExpr integers)+  , ("integers-from", UnaryExpr integers_from)+  , ("from", UnaryExpr integers_from)+  , ("integers-up-to", UnaryExpr integers_up_to)+  , ("up-to", UnaryExpr integers_up_to)   , ("is-integer", UnaryExpr is_integer)   , ("is-int", UnaryExpr is_integer)+  , ("int-add", NaryExpr integer_add_)   , ("integer-add", NaryExpr integer_add_)+  , ("int-sub", BinaryExpr integer_subtract)   , ("integer-subtract", BinaryExpr integer_subtract)   , ("integer-sub", BinaryExpr integer_subtract)   , ("integer-modulo", BinaryExpr stepMod)   , ("integer-mod", BinaryExpr stepMod)+  , ("int-mod", BinaryExpr stepMod)   , ("integer-multiply", NaryExpr integer_multiply_)   , ("int-mul", NaryExpr integer_multiply_)   , ("integer-divide", BinaryExpr integer_divide)@@ -30,6 +37,7 @@   , ("decimal-natural", UnaryExpr decimal_natural)   , ("natural-predecessor", UnaryExpr natural_predecessor)   , ("nat-pred", UnaryExpr natural_predecessor)+  , ("natural-successor", UnaryExpr natural_successor)   , ("nat-successor", UnaryExpr natural_successor)   , ("nat-succ", UnaryExpr natural_successor)   , ("integer-is-less", BinaryExpr is_less)@@ -57,6 +65,20 @@ integers_ = nullaryOp integers integers :: HasValues t => OpExpr t integers = vNullaryOp "integers" (Normal $ injectT Integers)++integers_from_ :: HasValues t => [OpExpr t] -> OpExpr t+integers_from_ = unaryOp integers_from+integers_from :: HasValues t => OpExpr t -> OpExpr t+integers_from = vUnaryOp "integers-from" op+  where op v | Int i <- upcastIntegers v = Normal $ injectT $ IntegersFrom i+             | otherwise = SortErr "integers-from not applied to an integer"++integers_up_to_ :: HasValues t => [OpExpr t] -> OpExpr t+integers_up_to_ = unaryOp integers_up_to+integers_up_to :: HasValues t => OpExpr t -> OpExpr t+integers_up_to = vUnaryOp "integers-up-to" op+  where op v | Int i <- upcastIntegers v = Normal $ injectT $ IntegersUpTo i+             | otherwise = SortErr "integers-up-to not applied to an integer"  is_integer_ :: HasValues t => [OpExpr t] -> OpExpr t is_integer_ = unaryOp is_integer

@@ -33,7 +33,7 @@ map_ = vNaryOp "map" op   where op vs | areBindings, allDistinct = Normal $ inject $ Map $ M.fromListWith const assocs               | not (areBindings)  = SortErr "map not applied to pairs"-              | otherwise       = Normal $ inject null__ +              | otherwise       = Normal $ inject null_value__            where areBindings   = all isBinding vs                   where isBinding (ADTVal "tuple" (k:vs))                           | Just _ <- project k@@ -84,10 +84,7 @@ map_lookup :: (HasValues t, Ord t) => OpExpr t -> OpExpr t -> OpExpr t map_lookup = vBinaryOp "map-lookup" op   where op xv k = case xv of -                    Map m -> case M.lookup k m of -                        Nothing -> Normal $ inject $ list [] -                        Just [ADTVal "no-value" []] -> Normal $ inject $ list []-                        Just vs -> Normal $ inject $ list vs+                    Map m -> Normal $ inject $ multi_ $ maybe [] id $ M.lookup k m                      _ -> SortErr "map-lookup(M,V) not applied to a map and a value"  map_delete_ :: (HasValues t, Ord t) => [OpExpr t] -> OpExpr t@@ -138,6 +135,6 @@ map_elements_ = unaryOp map_elements map_elements :: (Ord t, HasValues t) => OpExpr t -> OpExpr t map_elements = vUnaryOp "map-elements" op-  where op (Map m) = Normal $ inject $ ADTVal "list" (map inject $ M.foldrWithKey combine [] m)+  where op (Map m) = Normal $ inject $ multi $ map inject $ M.foldrWithKey combine [] m           where combine k vs ls = ADTVal "tuple" (inject k : map inject vs):ls         op _ = SortErr "map-elements not applied to a map"

@@ -7,7 +7,6 @@  import qualified Data.Set as S -import Test.RandomStrings (randomString', randomASCII) import System.IO.Unsafe (unsafePerformIO)  library :: (HasValues t, Ord t) => Library t@@ -55,7 +54,7 @@ set_elements_ = unaryOp set_elements set_elements :: HasValues t => OpExpr t -> OpExpr t set_elements = vUnaryOp "set-elements" op- where op (Set s) = Normal $ inject $ ADTVal "list" (map inject $ S.toList s)+ where op (Set s) = Normal $ inject $ multi $map inject $ S.toList s        op _ = SortErr "set-elements not applied to a set"  set_size_ :: (Ord t, HasValues t) => [OpExpr t] -> OpExpr t@@ -125,7 +124,6 @@   where op (ComputationType (Type ty)) (Set set) = case ty of            Atoms -> Normal $ inject $ head atoms           _     -> error "missing case for `element-not-in`"-          where getRnd   = randomString' randomASCII 1 1 5-                atoms    = dropWhile (flip S.member set) $ +          where atoms    = dropWhile (flip S.member set) $                                map (Atom . ("@" ++) . show) [1..]         op _ _ = SortErr "element-not-in not applied to a type and a set"

@@ -6,6 +6,8 @@ import Funcons.Operations.Internal import Funcons.Operations.Types +import Data.String+ library :: HasValues t => Library t library = libFromList [     ("is-string", UnaryExpr is_string)@@ -15,16 +17,17 @@  is_string_ :: HasValues t => [OpExpr t] -> OpExpr t is_string_ = unaryOp is_string-is_string x = RewritesTo "is-string" (type_member x (ValExpr (ComputationType (Type Strings)))) [x]+is_string x = RewritesTo "is-string" (type_member x (ValExpr (ComputationType (Type (ADT "strings" []))))) [x]  to_string_ :: HasValues t => [OpExpr t] -> OpExpr t to_string_ = unaryOp to_string to_string :: HasValues t => OpExpr t -> OpExpr t  to_string = vUnaryOp "to-string" stepTo_String -stepTo_String s | isString_ s = Normal $ inject $ s+stepTo_String s | isString_ s   = Normal $ inject $ s stepTo_String (Rational r)      = mk_string (show (fromRational r)) stepTo_String (Ascii c)         = mk_string ([c])+stepTo_String (Char c)          = mk_string ([c]) stepTo_String (Atom s)          = mk_string  s stepTo_String (Int i)           = mk_string  (show i) stepTo_String (Nat n)           = mk_string  (show n)@@ -34,8 +37,7 @@ stepTo_String (ADTVal "true" []) = mk_string "true" stepTo_String (ADTVal "false"[]) = mk_string "false" stepTo_String (ADTVal "null"[]) = mk_string "null"-stepTo_String v | isString_ v   = mk_string (unString v) stepTo_String v                 = DomErr ("to-string undefined on this type")  mk_string :: HasValues t => String -> Result t-mk_string = Normal . inject . ADTVal "list" . map (inject . Ascii)+mk_string = Normal . inject . fromString 

@@ -19,6 +19,7 @@ library = libFromList [     ("types", NullaryExpr types)   , ("value-types", NullaryExpr value_types)+  , ("empty-type", NullaryExpr empty_type) --  , ("null-type", NullaryExpr nulltype) --  , ("null", NullaryExpr null)   , ("values", NullaryExpr values)@@ -38,7 +39,7 @@ ground_values_ :: HasValues t => [OpExpr t] -> OpExpr t ground_values_ = nullaryOp ground_values ground_values :: HasValues t => OpExpr t-ground_values = vNullaryOp "ground-values" (Normal $ injectT GroundValues)+ground_values = vNullaryOp "ground-values" (Normal $ injectT (ADT "ground-values" []))  types_ :: HasValues t => [OpExpr t] -> OpExpr t types_ = nullaryOp types@@ -46,10 +47,15 @@ types = NullaryOp "types" (Normal $ injectT Types)  value_types_ :: HasValues t => [OpExpr t] -> OpExpr t-value_types_ = nullaryOp types+value_types_ = nullaryOp value_types value_types :: HasValues t => OpExpr t value_types = NullaryOp "value-types" (Normal $ injectT Types) +empty_type_ :: HasValues t => [OpExpr t] -> OpExpr t+empty_type_ = nullaryOp empty_type+empty_type :: HasValues t => OpExpr t+empty_type = NullaryOp "empty-types" (Normal $ injectT EmptyType)+ nulltype_ :: HasValues t => [OpExpr t] -> OpExpr t nulltype_ = nullaryOp nulltype  nulltype :: HasValues t => OpExpr t@@ -102,7 +108,7 @@ tyOf (Vector v)                 | V.null v = vectors Values                                 | otherwise = vectors (tyOf (v V.! 0)) tyOf VAny                       = Values-tyOf (VMeta t)                  = ASTs+tyOf (ValSeq ts)                = Values  type_member_ :: HasValues t => [OpExpr t] -> OpExpr t type_member_ = binaryOp type_member@@ -123,25 +129,20 @@ isInType :: HasValues t => Values t -> Types t -> Maybe Bool isInType _ EmptyType = return False isInType v Values = return True --(not (isNull v)) ---isInType n NullType = return (isNull n) -isInType v GroundValues = return (isGround v)+isInType n NullType = return (isNull n) +isInType v (ADT "ground-values" []) = return (isGround v) isInType v (ADT "strings" []) = return (isString_ v) isInType (ADTVal "list" vs') (ADT "lists" [ty'])    | Just ty <- projectT ty', Just vs <- sequence (map project vs') =    and <$> mapM (flip isInType ty) vs-isInType (ADTVal "true" []) (ADT "booleans" []) = return True-isInType (ADTVal "false" []) (ADT "booleans" []) = return True-isInType v (ADT "tuples" ttparams') -  | Just ttparams <- sequence (map projectT ttparams') = case v of-    ADTVal "tuple" vs' | Just vs <- sequence (map project vs')-                            -> isInTupleType vs ttparams-    _                       -> isInTupleType [v] ttparams + isInType v (ADT nm tys) = Nothing isInType (ADTVal _ _) ADTs = return True isInType (Atom _) Atoms = return True isInType (Ascii _) Characters = return True isInType (Char _) Characters = return True isInType (Ascii _) AsciiCharacters = return True+isInType (Char _) AsciiCharacters = return True isInType (Bit bv) (Bits n) = return (BV.size bv == n) isInType v (IntegersFrom n)      | Int i <- upcastIntegers v = return (i >= n)@@ -160,7 +161,6 @@ isInType v (Union ty1 ty2) = (||) <$> isInType v ty1 <*> isInType v ty2 isInType v (Complement ty) = not <$> isInType v ty isInType v (Intersection ty1 ty2) = (&&) <$> isInType v ty1 <*> isInType v ty2-isInType (VMeta _) ASTs = return True -- for meta-programming (see Funcons.MetaProgramming) isInType _ _ = return False  isInTupleType :: HasValues t => [Values t] -> [Types t] -> Maybe Bool

@@ -41,9 +41,9 @@                 | Rational Rational                 | Set (ValueSets (Values t))                 | Vector (ValueVectors (Values t))-                | VMeta (TaggedSyntax t)                 | VAny -- used whenever funcon terms may have holes in them                        -- currently only the case in "downwards" flowing signals+                | ValSeq [t] -- represents a multitude of values         deriving (Eq,Ord,Show,Read)  tuple :: HasValues t => [Values t] -> Values t@@ -52,13 +52,18 @@ list :: HasValues t => [Values t] -> Values t list = ADTVal "list" . map inject -instance HasValues t => IsString (Values t) where-  fromString = ADTVal "list" . map (inject . Ascii)+vector :: HasValues t => [Values t] -> Values t+vector = ADTVal "vector" . map inject  -data TaggedSyntax t = TagName Name [Values t]-                    | TagType (Types t) (Values t)-                  deriving (Eq, Ord, Show, Read)+multi :: HasValues t => [t] -> Values t +multi = ValSeq  +multi_ :: HasValues t => [Values t] -> Values t+multi_ = multi . map inject++instance HasValues t => IsString (Values t) where+  fromString = ADTVal "list" . map (inject . Char)+ type ValueMaps t      = M.Map t [t]  type ValueSets t      = S.Set t type ValueVectors t   = V.Vector t@@ -88,20 +93,16 @@             | Complement (Types t)             | ComputationTypes             | EmptyType-            | GroundValues             | IEEEFloats IEEEFormats             | Integers             | Intersection (Types t) (Types t)             | Naturals             | NullType              | Rationals-            | Strings             | Types             | UnicodeCharacters             | Union (Types t) (Types t)             | Values-            -- extension for meta-programming (see Funcons.MetaProgramming)-            | ASTs               deriving (Ord,Eq,Show,Read)  sets :: HasValues t => Types t -> Types t@@ -159,14 +160,10 @@     Nat n             -> Nat n     Rational r        -> Rational r     Vector v          -> Vector $ V.map (vmap f) v-    VMeta ts          -> VMeta $ vmapTS f ts-    VAny              -> VAny+    VAny              -> VAny +    ValSeq ts         -> ValSeq (map f ts) -vmapTS :: (Ord b) => (a -> b) -> TaggedSyntax a -> TaggedSyntax b-vmapTS f ts = case ts of-    TagName nm vs -> TagName nm (map (vmap f) vs)-    TagType t v   -> TagType (fmap f t) (vmap f v) -  +  traverseV :: (Ord b, Monad m, HasValues a, HasValues b) =>    (a -> m b) -> Values a -> m (Values b) traverseV f = traverseVM f (mapM f)@@ -194,8 +191,8 @@     Nat n             -> return $ Nat n     Rational r        -> return $ Rational r     Vector v          -> return . Vector . V.fromList . map (fromJust . project) =<< fs (map inject $ V.toList v)-    VMeta ts -> VMeta <$> traverseTSM f fs ts     VAny -> return VAny+    ValSeq ts -> ValSeq <$> fs ts  traverseT :: (Ord b, Monad m, HasValues a, HasValues b) =>    (a -> m b) -> Types a -> m (Types b)@@ -208,12 +205,10 @@   AsciiCharacters -> return AsciiCharacters   Atoms ->  return Atoms   AnnotatedType ty op -> AnnotatedType <$> traverseTM f fs ty <*> return op-  ASTs -> return ASTs   Bits i -> return (Bits i)   Characters -> return Characters   ComputationTypes -> return ComputationTypes   Complement t -> Complement <$> traverseTM f fs t  -  GroundValues -> return GroundValues   IntegersFrom f -> return (IntegersFrom f)   IntegersUpTo f -> return (IntegersUpTo f)   Intersection t1 t2 -> Intersection <$> traverseTM f fs t1 <*> traverseTM f fs t2@@ -223,16 +218,11 @@   Integers -> return Integers   Naturals -> return Naturals   Rationals -> return Rationals-  Strings -> return Strings   Types -> return Types    UnicodeCharacters -> return UnicodeCharacters   Union t1 t2 -> Union <$> traverseTM f fs t1 <*> traverseTM f fs t2   Values -> return Values -traverseTSM f fs t = case t of-  TagName nm vs -> TagName nm <$> traverse (traverseVM f fs) vs-  TagType ty v  -> TagType <$> traverseTM f fs ty <*> traverseVM f fs v- traverseCTM f fs t = case t of   Type t -> Type <$> traverseTM f fs t   ComputesType t -> ComputesType <$> traverseTM f fs t@@ -316,20 +306,11 @@   (VAny, VAny)  -> Just (Just mempty)   (_, VAny)     -> Nothing   (VAny, _)     -> Nothing-  (VMeta ts, VMeta ts') -> structTSMcompare comp comps ts ts' -  (VMeta _, _)  -> Nothing-  (_, VMeta _)  -> Nothing+  (ValSeq ts, ValSeq ts') -> Just (comps ts ts')+  (ValSeq _, _)           -> Nothing+  (_, ValSeq _)           -> Nothing   where comps' xs ys = comps (map inject xs) (map inject ys) -structTSMcompare comp comps ts ts' = case (ts,ts') of-  (TagName nm vs, TagName nm' vs') | nm == nm' -> -    Just $ comps (map inject vs) (map inject vs')  -  (TagName _ _, _) -> Nothing-  (_, TagName _ _) -> Nothing-  (TagType ty v, TagType ty' v') -> -    liftM2 (liftM2 mappend) (structTMcompare comp comps ty ty')-                            (structVMcompare comp comps v v')- structTMcompare :: (Monoid m, HasValues a, HasValues b) =>    (a -> b -> Maybe m) -> ([a] -> [b] -> Maybe m) ->      Types a -> Types b -> Maybe (Maybe m)@@ -346,9 +327,6 @@   (AsciiCharacters, AsciiCharacters)  -> Just (Just mempty)    (AsciiCharacters, _)                -> Nothing   (_, AsciiCharacters)                -> Nothing-  (ASTs, ASTs)                        -> Just (Just mempty)-  (_, ASTs)                           -> Nothing-  (ASTs, _)                           -> Nothing   (AnnotatedType t1 op1, AnnotatedType t2 op2) | op1 == op2 -> structTMcompare comp comps t1 t2   (AnnotatedType _ _, _)              -> Nothing   (_, AnnotatedType _ _)              -> Nothing@@ -364,9 +342,6 @@   (ComputationTypes, ComputationTypes)-> Just (Just mempty)   (_, ComputationTypes)               -> Nothing   (ComputationTypes, _)               -> Nothing-  (GroundValues, GroundValues)        -> Just (Just mempty)-  (GroundValues, _)                   -> Nothing-  (_, GroundValues)                   -> Nothing   (IntegersFrom mx, IntegersFrom mx') | mx == mx' -> Just (Just mempty)   (IntegersFrom _, _)                 -> Nothing   (_, IntegersFrom _)                 -> Nothing@@ -394,9 +369,6 @@   (Rationals, Rationals)              -> Just (Just mempty)   (Rationals, _)                      -> Nothing   (_, Rationals)                      -> Nothing-  (Strings, Strings)                  -> Just (Just mempty) -  (_, Strings)                        -> Nothing-  (Strings, _)                        -> Nothing   (Types, Types)                      -> Just (Just mempty)   (_, Types)                          -> Nothing   (Types, _)                          -> Nothing@@ -415,11 +387,9 @@     AsciiCharacters     -> AsciiCharacters     Atoms               -> Atoms     AnnotatedType ty op -> AnnotatedType (fmap f ty) op-    ASTs                -> ASTs     Bits n              -> Bits n     Complement t1       -> Complement (fmap f t1)     ComputationTypes    -> ComputationTypes-    GroundValues        -> GroundValues     IntegersFrom p      -> IntegersFrom p     IntegersUpTo p      -> IntegersUpTo p     Characters          -> Characters   @@ -430,7 +400,6 @@     Naturals            -> Naturals     NullType            -> NullType     Rationals           -> Rationals-    Strings             -> Strings     Types               -> Types     UnicodeCharacters   -> UnicodeCharacters     Union t1 t2         -> Union (fmap f t1) (fmap f t2)@@ -448,13 +417,11 @@     ADTs                -> mempty     AsciiCharacters     -> mempty     Atoms               -> mempty-    ASTs                -> mempty     AnnotatedType ty op -> foldMap f ty     Bits _              -> mempty     Characters          -> mempty     Complement t1       -> foldMap f t1     ComputationTypes    -> mempty-    GroundValues        -> mempty     IntegersUpTo q      -> mempty     IntegersFrom q      -> mempty     Intersection t1 t2  -> foldMap f t1 `mappend` foldMap f t2@@ -464,7 +431,6 @@     Naturals            -> mempty      NullType            -> mempty     Rationals           -> mempty-    Strings             -> mempty     Types               -> mempty      UnicodeCharacters   -> mempty      Union t1 t2         -> foldMap f t1 `mappend` foldMap f t2@@ -477,12 +443,10 @@     AsciiCharacters     -> pure AsciiCharacters     AnnotatedType ty op -> AnnotatedType <$> traverse f ty <*> pure op     Atoms               -> pure Atoms-    ASTs                -> pure ASTs     Bits n              -> pure $ Bits n     Characters          -> pure Characters     Complement t        -> Complement <$> traverse f t     ComputationTypes    -> pure ComputationTypes-    GroundValues        -> pure GroundValues      IntegersFrom n      -> pure $ IntegersFrom n     IntegersUpTo n        -> pure $ IntegersUpTo n     EmptyType           -> pure EmptyType@@ -492,7 +456,6 @@     Naturals            -> pure Naturals     NullType            -> pure NullType     Rationals           -> pure Rationals-    Strings             -> pure Strings     Types               -> pure Types     UnicodeCharacters   -> pure UnicodeCharacters     Union t1 t2         -> Union <$> traverse f t1 <*> traverse f t2@@ -577,8 +540,8 @@ isGround (Rational _)             = True isGround (Set s)                  = all isGround (S.toList s) isGround (Vector v)               = all isGround (V.toList v)-isGround (VMeta _)                = True isGround VAny                     = False+isGround (ValSeq ts)              = all (maybe False isGround . project) ts  -- functions that check simple properties of funcons -- TODO: Some of these are used, and all are exported by Funcons.EDSL@@ -597,7 +560,7 @@ isSet ((Set _))                     = True isSet _                             = False isString_ :: HasValues t => Values t -> Bool-isString_ (ADTVal "list" vs)        = not (null vs) && all (maybe False isAscii) (map project vs)+isString_ (ADTVal "list" vs)        = not (null vs) && all (maybe False (isChar . upcastUnicode)) (map project vs) isString_ _                         = False isType (ComputationType _)          = True isType _                            = False@@ -606,7 +569,8 @@  unString :: HasValues t => Values t -> String unString (ADTVal "list" vs) -  | Just vs' <- sequence (map project vs), all isAscii vs' = map (\(Ascii c) -> c) vs'+  | Just vs' <- sequence (map (fmap upcastUnicode . project) vs)+  , all isChar vs' = map (\(Char c) -> c) vs' unString _ = error "unString"  null__ :: Values t@@ -617,6 +581,7 @@  isNull :: Values t -> Bool isNull (ADTVal "null" _) = True+isNull (ADTVal "null-value" _) = True isNull _ = False  isDefinedVal :: Values t -> Bool@@ -645,19 +610,16 @@ ppValues showT (Nat f)        = show f ppValues showT (Map m)        = if M.null m then "map-empty"                                else "{" ++ key_values ++ "}"- where key_values = intercalate ", " (map (\(k,v) -> -                      ppValues showT k++" |-> "++ -                      showArgs (map (ppValues showT) v)) $ M.toList m)+ where key_values = intercalate ", " (map showKP $ M.assocs m)+        where showKP (k,vs) = ppValues showT k ++ " |-> " ++   +                case vs of [v] -> ppValues showT v+                           _   -> showArgs (map (ppValues showT) vs) ppValues showT (Multiset s) = "{" ++ showArgs (map (ppValues showT) (MS.toList s)) ++ "}" ppValues showT (Set s) =  "{" ++ showArgs (map (ppValues showT) (S.toList s)) ++ "}" ppValues showT (Vector v) =  "vector" ++ showArgs (map (ppValues showT) (V.toList v)) ppValues showT (ComputationType ty) = ppComputationTypes showT ty ppValues showT VAny = "_"-ppValues showT (VMeta ts) = ppTaggedSyntax showT ts--ppTaggedSyntax :: HasValues t => (t -> String) -> TaggedSyntax t -> String-ppTaggedSyntax showT (TagName nm vs) = "astv" ++ showArgs (unpack nm : map (ppValues showT) vs)-ppTaggedSyntax showT (TagType ty val) = "astv" ++ showArgs [ppTypes showT ty, ppValues showT val]+ppValues showT (ValSeq ts) = showArgs_ (map showT ts)  ppComputationTypes :: HasValues t => (t -> String) -> ComputationTypes t -> String ppComputationTypes showT (Type t) = ppTypes showT t@@ -668,9 +630,7 @@ ppTypes showT (AnnotatedType ty op)  = ppTypes showT ty ++ ppOp op ppTypes showT (Complement ty)        = "~(" ++ ppTypes showT ty ++ ")" ppTypes showT ComputationTypes       = "computation-types"-ppTypes showT GroundValues           = "ground-values" ppTypes showT NullType               = "null-type"-ppTypes showT ASTs                   = "asts" ppTypes showT Atoms                  = "atoms" ppTypes showT AsciiCharacters        = "ascii-characters" ppTypes showT Characters             = "characters"@@ -680,7 +640,6 @@ ppTypes showT EmptyType              = "empty-type" ppTypes showT (UnicodeCharacters)    = "unicode-characters" ppTypes showT (Integers)             = "integers"-ppTypes showT (Strings)              = "strings" ppTypes showT (Values)               = "values" ppTypes showT Types                  = "types" ppTypes showT ADTs                   = "algebraic-datatypes"