cspm/src/HST/CSPM/Utils.hs @@ -14,6 +14,7 @@ Library Other-Modules: HST.CSPM.Environments, HST.CSPM.Evaluate, HST.CSPM.Expressions, + HST.CSPM.Utils, HST.CSPM.Values Executable tests cspm/HST.cabal @@ -24,23 +24,10 @@ module HST.CSPM.Evaluate where import Data.List +import HST.CSPM.Utils import HST.CSPM.Expressions import HST.CSPM.Values -eval :: Expression -> Value - -eval EBottom = VBottom -eval (ENumber id) = VNumber (evalNumber id) -eval (ESequence s) = VSequence (evalSequence s) -eval (ESet a) = VSet (evalSet a) -eval (EBoolean b) = VBoolean (evalBoolean b) -eval (ETuple t) = VTuple (evalTuple t) -eval (QHead s) = head (evalAsSequence s) -eval (EIfThenElse b x y) = if (evalAsBoolean b) then - eval x - else - eval y - evalAsNumber :: Expression -> Int evalAsNumber = coerceNumber . eval @@ -56,86 +43,79 @@ evalAsBoolean = coerceBoolean . eval evalAsTuple :: Expression -> [Value] evalAsTuple = coerceTuple . eval +eval :: Expression -> Value + +eval EBottom = VBottom + +-- Expressions that evaluate to a number + +eval (ENLit i) = VNumber $ i +eval (ENNeg m) = VNumber $ -(evalAsNumber m) +eval (ENSum m n) = VNumber $ (evalAsNumber m) + (evalAsNumber n) +eval (ENDiff m n) = VNumber $ (evalAsNumber m) - (evalAsNumber n) +eval (ENProd m n) = VNumber $ (evalAsNumber m) * (evalAsNumber n) +eval (ENQuot m n) = VNumber $ (evalAsNumber m) `quot` (evalAsNumber n) +eval (ENRem m n) = VNumber $ (evalAsNumber m) `rem` (evalAsNumber n) +eval (EQLength s) = VNumber $ length (evalAsSequence s) +eval (ESCardinality a) = VNumber $ length (evalAsSet a) + +-- Expressions that evaluate to a sequence + +eval (EQLit xs) = VSequence $ map eval xs +eval (EQClosedRange m n) = VSequence $ + map VNumber + [evalAsNumber m .. evalAsNumber n] +eval (EQOpenRange m) = VSequence $ + map VNumber + [evalAsNumber m .. ] +eval (EQConcat s t) = VSequence $ + (evalAsSequence s) ++ (evalAsSequence t) +eval (EQTail s) = VSequence $ tail (evalAsSequence s) + +-- Expressions that evaluate to a set + +eval (ESLit xs) = VSet $ nub (map eval xs) +eval (ESClosedRange m n) = VSet $ map VNumber + [evalAsNumber m .. evalAsNumber n] +eval (ESOpenRange m) = VSet $ map VNumber [evalAsNumber m ..] +eval (ESUnion a b) = VSet $ (evalAsSet a) `union` (evalAsSet b) +eval (ESIntersection a b) = VSet $ (evalAsSet a) `intersect` (evalAsSet b) +eval (ESDifference a b) = VSet $ (evalAsSet a) \\ (evalAsSet b) +eval (ESDistUnion aa) = VSet $ distUnion + (map coerceSet (evalAsSet aa)) +eval (ESDistIntersection aa) = VSet $ distIntersect + (map coerceSet (evalAsSet aa)) +eval (EQSet s) = VSet $ nub (evalAsSequence s) +eval (ESPowerset a) = VSet $ map VSet (powerset (evalAsSet a)) +eval (ESSequenceset a) = VSet $ map VSequence (sequenceset (evalAsSet a)) + +-- Expressions that evaluate to a boolean + +eval EBTrue = VBoolean $ True +eval EBFalse = VBoolean $ False +eval (EBAnd b1 b2) = VBoolean $ (evalAsBoolean b1) && (evalAsBoolean b2) +eval (EBOr b1 b2) = VBoolean $ (evalAsBoolean b1) || (evalAsBoolean b2) +eval (EBNot b) = VBoolean $ not (evalAsBoolean b) +eval (EEqual x y) = VBoolean $ (eval x) == (eval y) +eval (ENotEqual x y) = VBoolean $ (eval x) /= (eval y) +eval (ELT x y) = VBoolean $ (eval x) < (eval y) +eval (EGT x y) = VBoolean $ (eval x) > (eval y) +eval (ELTE x y) = VBoolean $ (eval x) <= (eval y) +eval (EGTE x y) = VBoolean $ (eval x) >= (eval y) +eval (EQEmpty s) = VBoolean $ null (evalAsSequence s) +eval (EQIn x s) = VBoolean $ (eval x) `elem` (evalAsSequence s) +eval (ESIn x a) = VBoolean $ (eval x) `elem` (evalAsSet a) +eval (ESEmpty a) = VBoolean $ null (evalAsSet a) + +-- Expressions that evaluate to a tuple + +eval (ETLit xs) = VTuple $ map eval xs + +-- Expressions that can evaluate to anything + +eval (EQHead s) = head (evalAsSequence s) -evalNumber :: Number -> Int - -evalNumber (NLit i) = i -evalNumber (NNeg m) = -(evalAsNumber m) -evalNumber (NSum m n) = (evalAsNumber m) + (evalAsNumber n) -evalNumber (NDiff m n) = (evalAsNumber m) - (evalAsNumber n) -evalNumber (NProd m n) = (evalAsNumber m) * (evalAsNumber n) -evalNumber (NQuot m n) = (evalAsNumber m) `quot` (evalAsNumber n) -evalNumber (NRem m n) = (evalAsNumber m) `rem` (evalAsNumber n) -evalNumber (QLength s) = length (evalAsSequence s) -evalNumber (SCardinality a) = length (evalAsSet a) - - -evalSequence :: Sequence -> [Value] - -evalSequence (QLit xs) = map eval xs -evalSequence (QClosedRange m n) = map VNumber - [evalAsNumber m .. evalAsNumber n] -evalSequence (QOpenRange m) = map VNumber - [evalAsNumber m .. ] -evalSequence (QConcat s t) = (evalAsSequence s) ++ (evalAsSequence t) -evalSequence (QTail s) = tail (evalAsSequence s) - - -distUnion :: Eq a => [[a]] -> [a] -distUnion xss = foldr union [] xss - -distIntersect :: Eq a => [[a]] -> [a] -distIntersect [] = [] -distIntersect xss = foldr1 intersect xss - -powerset :: [a] -> [[a]] - -powerset [] = [[]] -powerset (x:xs) = ps ++ map (x:) ps - where - ps = powerset xs - -sequenceset :: [a] -> [[a]] -sequenceset as = [[]] ++ - concat (map (\xs -> (map (:xs) as)) (sequenceset as)) - -evalSet :: Set -> [Value] - -evalSet (SLit xs) = nub (map eval xs) -evalSet (SClosedRange m n) = map VNumber - [evalAsNumber m .. evalAsNumber n] -evalSet (SOpenRange m) = map VNumber [evalAsNumber m ..] -evalSet (SUnion a b) = (evalAsSet a) `union` (evalAsSet b) -evalSet (SIntersection a b) = (evalAsSet a) `intersect` (evalAsSet b) -evalSet (SDifference a b) = (evalAsSet a) \\ (evalAsSet b) -evalSet (SDistUnion aa) = distUnion - (map coerceSet (evalAsSet aa)) -evalSet (SDistIntersection aa) = distIntersect - (map coerceSet (evalAsSet aa)) -evalSet (QSet s) = nub (evalAsSequence s) -evalSet (SPowerset a) = map VSet (powerset (evalAsSet a)) -evalSet (SSequenceset a) = map VSequence (sequenceset (evalAsSet a)) - - -evalBoolean :: Boolean -> Bool - -evalBoolean BTrue = True -evalBoolean BFalse = False -evalBoolean (BAnd b1 b2) = (evalAsBoolean b1) && (evalAsBoolean b2) -evalBoolean (BOr b1 b2) = (evalAsBoolean b1) || (evalAsBoolean b2) -evalBoolean (BNot b) = not (evalAsBoolean b) -evalBoolean (EEqual x y) = (eval x) == (eval y) -evalBoolean (ENotEqual x y) = (eval x) /= (eval y) -evalBoolean (ELT x y) = (eval x) < (eval y) -evalBoolean (EGT x y) = (eval x) > (eval y) -evalBoolean (ELTE x y) = (eval x) <= (eval y) -evalBoolean (EGTE x y) = (eval x) >= (eval y) -evalBoolean (QEmpty s) = null (evalAsSequence s) -evalBoolean (QIn x s) = (eval x) `elem` (evalAsSequence s) -evalBoolean (SIn x a) = (eval x) `elem` (evalAsSet a) -evalBoolean (SEmpty a) = null (evalAsSet a) - - -evalTuple :: Tuple -> [Value] - -evalTuple (TLit xs) = map eval xs +eval (EIfThenElse b x y) = if (evalAsBoolean b) then + eval x + else + eval y cspm/src/HST/CSPM/Evaluate.hs @@ -42,149 +42,126 @@ instance Show Binding where data Expression = EBottom - | ENumber Number - | ESequence Sequence - | ESet Set - | EBoolean Boolean - | ETuple Tuple - | QHead Expression - | EIfThenElse Expression Expression Expression - deriving (Eq, Ord) -instance Show Expression where - show EBottom = "Bottom" - show (ENumber n) = show n - show (ESequence s) = show s - show (ESet a) = show a - show (EBoolean b) = show b - show (ETuple t) = show t - show (QHead x) = "head(" ++ show x ++ ")" - show (EIfThenElse b x y) = "if (" ++ show b ++ ") then " ++ - show x ++ " else " ++ show y - - -- We don't want to show the [] brackets when showing a list of - -- expressions, since we're going to use different brackets - -- depending on whether the list represents a sequence, set, or - -- tuple literal. - - showList [] = showString "" - showList (x:xs) = shows x . showl xs - where - showl [] = id - showl (x:xs) = showChar ',' . shows x . showl xs - --- Numbers - -data Number - = NLit Int - | NNeg Expression - | NSum Expression Expression - | NDiff Expression Expression - | NProd Expression Expression - | NQuot Expression Expression - | NRem Expression Expression - | QLength Expression - | SCardinality Expression - deriving (Eq, Ord) - -instance Show Number where - show (NLit i) = show i - show (NNeg m) = "(-" ++ show m ++ ")" - show (NSum m n) = "(" ++ show m ++ " + " ++ show n ++ ")" - show (NDiff m n) = "(" ++ show m ++ " - " ++ show n ++ ")" - show (NProd m n) = "(" ++ show m ++ " * " ++ show n ++ ")" - show (NQuot m n) = "(" ++ show m ++ " / " ++ show n ++ ")" - show (NRem m n) = "(" ++ show m ++ " % " ++ show n ++ ")" - show (QLength s) = "(#" ++ show s ++ ")" - show (SCardinality a) = "(#" ++ show a ++ ")" - --- Sequences - -data Sequence - = QLit [Expression] - | QClosedRange Expression Expression - | QOpenRange Expression - | QConcat Expression Expression - | QTail Expression + -- Expressions which evaluate to a number + | ENLit Int + | ENNeg Expression + | ENSum Expression Expression + | ENDiff Expression Expression + | ENProd Expression Expression + | ENQuot Expression Expression + | ENRem Expression Expression + | EQLength Expression + | ESCardinality Expression + + -- Expressions which evaluate to a sequence + | EQLit [Expression] + | EQClosedRange Expression Expression + | EQOpenRange Expression + | EQConcat Expression Expression + | EQTail Expression -- TODO: sequence comprehension - deriving (Eq, Ord) -instance Show Sequence where - show (QLit xs) = "<" ++ show xs ++ ">" - show (QClosedRange m n) = "<" ++ show m ++ ".." ++ show n ++ ">" - show (QOpenRange m) = "<" ++ show m ++ "..>" - show (QConcat s t) = "concat(" ++ show s ++ ", " ++ show t ++ ")" - show (QTail s) = "tail(" ++ show s ++ ")" - --- Sets - -data Set - = SLit [Expression] - | SClosedRange Expression Expression - | SOpenRange Expression - | SUnion Expression Expression - | SIntersection Expression Expression - | SDifference Expression Expression - | SDistUnion Expression - | SDistIntersection Expression - | QSet Expression - | SPowerset Expression - | SSequenceset Expression + -- Expressions which evaluate to a set + | ESLit [Expression] + | ESClosedRange Expression Expression + | ESOpenRange Expression + | ESUnion Expression Expression + | ESIntersection Expression Expression + | ESDifference Expression Expression + | ESDistUnion Expression + | ESDistIntersection Expression + | EQSet Expression + | ESPowerset Expression + | ESSequenceset Expression -- TODO: set comprehension - deriving (Eq, Ord) -instance Show Set where - show (SLit xs) = "{" ++ show xs ++ "}" - show (SClosedRange m n) = "{" ++ show m ++ ".." ++ show n ++ "}" - show (SOpenRange m) = "{" ++ show m ++ "..}" - show (SUnion s1 s2) = "union(" ++ show s1 ++ ", " ++ show s2 ++ "}" - show (SIntersection s1 s2) = "inter(" ++ show s1 ++ ", " ++ show s2 ++ "}" - show (SDifference s1 s2) = "diff(" ++ show s1 ++ ", " ++ show s2 ++ "}" - show (SDistUnion s1) = "Union(" ++ show s1 ++ ")" - show (SDistIntersection s1) = "Inter(" ++ show s1 ++ ")" - show (QSet q0) = "set(" ++ show q0 ++ ")" - show (SPowerset s1) = "Set(" ++ show s1 ++ ")" - show (SSequenceset s1) = "Seq(" ++ show s1 ++ ")" - --- Booleans - -data Boolean - = BTrue - | BFalse - | BAnd Expression Expression - | BOr Expression Expression - | BNot Expression + -- Expressions which evaluate to a boolean + | EBTrue + | EBFalse + | EBAnd Expression Expression + | EBOr Expression Expression + | EBNot Expression | EEqual Expression Expression | ENotEqual Expression Expression | ELT Expression Expression | EGT Expression Expression | ELTE Expression Expression | EGTE Expression Expression - | QEmpty Expression - | QIn Expression Expression - | SIn Expression Expression - | SEmpty Expression + | EQEmpty Expression + | EQIn Expression Expression + | ESIn Expression Expression + | ESEmpty Expression + + -- Expressions which evaluate to a tuple + | ETLit [Expression] + + -- Expressions which can evaluate to anything + | EQHead Expression + | EIfThenElse Expression Expression Expression + deriving (Eq, Ord) -instance Show Boolean where - show BTrue = "true" - show BFalse = "false" - show (BAnd b1 b2) = "(" ++ show b1 ++ " && " ++ show b2 ++ ")" - show (BOr b1 b2) = "(" ++ show b1 ++ " || " ++ show b2 ++ ")" - show (BNot b1) = "(!" ++ show b1 ++ ")" +instance Show Expression where + show EBottom = "Bottom" + + show (ENLit i) = show i + show (ENNeg m) = "(-" ++ show m ++ ")" + show (ENSum m n) = "(" ++ show m ++ " + " ++ show n ++ ")" + show (ENDiff m n) = "(" ++ show m ++ " - " ++ show n ++ ")" + show (ENProd m n) = "(" ++ show m ++ " * " ++ show n ++ ")" + show (ENQuot m n) = "(" ++ show m ++ " / " ++ show n ++ ")" + show (ENRem m n) = "(" ++ show m ++ " % " ++ show n ++ ")" + show (EQLength s) = "(#" ++ show s ++ ")" + show (ESCardinality a) = "(#" ++ show a ++ ")" + + show (EQLit xs) = "<" ++ show xs ++ ">" + show (EQClosedRange m n) = "<" ++ show m ++ ".." ++ show n ++ ">" + show (EQOpenRange m) = "<" ++ show m ++ "..>" + show (EQConcat s t) = "concat(" ++ show s ++ ", " ++ show t ++ ")" + show (EQTail s) = "tail(" ++ show s ++ ")" + + show (ESLit xs) = "{" ++ show xs ++ "}" + show (ESClosedRange m n) = "{" ++ show m ++ ".." ++ show n ++ "}" + show (ESOpenRange m) = "{" ++ show m ++ "..}" + show (ESUnion s1 s2) = "union(" ++ show s1 ++ ", " ++ show s2 ++ "}" + show (ESIntersection s1 s2) = "inter(" ++ show s1 ++ ", " ++ show s2 ++ "}" + show (ESDifference s1 s2) = "diff(" ++ show s1 ++ ", " ++ show s2 ++ "}" + show (ESDistUnion s1) = "Union(" ++ show s1 ++ ")" + show (ESDistIntersection s1) = "Inter(" ++ show s1 ++ ")" + show (EQSet q0) = "set(" ++ show q0 ++ ")" + show (ESPowerset s1) = "Set(" ++ show s1 ++ ")" + show (ESSequenceset s1) = "Seq(" ++ show s1 ++ ")" + + show EBTrue = "true" + show EBFalse = "false" + show (EBAnd b1 b2) = "(" ++ show b1 ++ " && " ++ show b2 ++ ")" + show (EBOr b1 b2) = "(" ++ show b1 ++ " || " ++ show b2 ++ ")" + show (EBNot b1) = "(!" ++ show b1 ++ ")" show (EEqual e1 e2) = "(" ++ show e1 ++ " == " ++ show e2 ++ ")" show (ENotEqual e1 e2) = "(" ++ show e1 ++ " != " ++ show e2 ++ ")" show (ELT e1 e2) = "(" ++ show e1 ++ " < " ++ show e2 ++ ")" show (EGT e1 e2) = "(" ++ show e1 ++ " > " ++ show e2 ++ ")" show (ELTE e1 e2) = "(" ++ show e1 ++ " <= " ++ show e2 ++ ")" show (EGTE e1 e2) = "(" ++ show e1 ++ " >= " ++ show e2 ++ ")" - show (QEmpty q0) = "null(" ++ show q0 ++ ")" - show (QIn x q0) = "elem(" ++ show x ++ ", " ++ show q0 ++ ")" - show (SIn x s0) = "member(" ++ show x ++ ", " ++ show s0 ++ ")" - show (SEmpty s0) = "empty(" ++ show s0 ++ ")" + show (EQEmpty q0) = "null(" ++ show q0 ++ ")" + show (EQIn x q0) = "elem(" ++ show x ++ ", " ++ show q0 ++ ")" + show (ESIn x s0) = "member(" ++ show x ++ ", " ++ show s0 ++ ")" + show (ESEmpty s0) = "empty(" ++ show s0 ++ ")" + + show (ETLit xs) = "(" ++ show xs ++ ")" --- Tuples + show (EQHead x) = "head(" ++ show x ++ ")" + show (EIfThenElse b x y) = "if (" ++ show b ++ ") then " ++ + show x ++ " else " ++ show y -data Tuple - = TLit [Expression] - deriving (Eq, Ord, Show) + -- We don't want to show the [] brackets when showing a list of + -- expressions, since we're going to use different brackets + -- depending on whether the list represents a sequence, set, or + -- tuple literal. + + showList [] = showString "" + showList (x:xs) = shows x . showl xs + where + showl [] = id + showl (x:xs) = showChar ',' . shows x . showl xs cspm/src/HST/CSPM/Expressions.hs @@ -39,29 +39,24 @@ prop_BoolAnd = forAll (two eboolean) tester where tester (eb1, eb2) = v0 == v12 where - v0 = eval (EBoolean (BAnd eb1 eb2)) - v1 = eval eb1 - v2 = eval eb2 - VBoolean b1 = v1 - VBoolean b2 = v2 + v0 = eval (EBAnd eb1 eb2) + b1 = evalAsBoolean eb1 + b2 = evalAsBoolean eb2 v12 = VBoolean (b1 && b2) prop_BoolOr = forAll (two eboolean) tester where tester (eb1, eb2) = v0 == v12 where - v0 = eval (EBoolean (BOr eb1 eb2)) - v1 = eval eb1 - v2 = eval eb2 - VBoolean b1 = v1 - VBoolean b2 = v2 + v0 = eval (EBOr eb1 eb2) + b1 = evalAsBoolean eb1 + b2 = evalAsBoolean eb2 v12 = VBoolean (b1 || b2) prop_BoolNot = forAll eboolean tester where tester eb1 = v0 == v1 where - v0 = eval (EBoolean (BNot eb1)) - v1' = eval eb1 - VBoolean b1' = v1' - v1 = VBoolean (not b1') + v0 = eval (EBNot eb1) + b1 = evalAsBoolean eb1 + v1 = VBoolean (not b1) cspm/tests/HST/CSPM/Tests/Booleans.hs @@ -30,48 +30,45 @@ import HST.CSPM checkAll checker props = foldl (>>) (return ()) $ map checker props -number :: Gen Number -number = sized number' - where - number' 0 = liftM NLit arbitrary - number' n | n > 0 = oneof [liftM NLit arbitrary, - liftM NNeg subnum, - liftM2 NSum subnum subnum, - liftM2 NDiff subnum subnum, - liftM2 NProd subnum subnum - --liftM2 NQuot subnum subnum, - --liftM2 NRem subnum subnum - ] - where - subnum = liftM ENumber $ number' (n `div` 2) - -enumber :: Gen Expression -enumber = liftM ENumber number listOf :: Gen a -> Gen [a] listOf g = sized listOf' where listOf' n = sequence [g | i <- [1..n]] -qsequence = listOf enumber -esequence = liftM (ESequence . QLit) qsequence +pair :: Gen a -> Gen b -> Gen (a, b) +pair = liftM2 (curry id) + -boolean :: Gen Boolean -boolean = sized boolean' +enumber :: Gen Expression +enumber = sized number' where - boolean' 0 = oneof [return BTrue, return BFalse] - boolean' n | n > 0 = oneof [liftM2 BAnd subbool subbool, - liftM2 BOr subbool subbool, - liftM BNot subbool + number' 0 = liftM ENLit arbitrary + number' n | n > 0 = oneof [liftM ENLit arbitrary, + liftM ENNeg subnum, + liftM2 ENSum subnum subnum, + liftM2 ENDiff subnum subnum, + liftM2 ENProd subnum subnum + --liftM2 ENQuot subnum subnum, + --liftM2 ENRem subnum subnum + ] + where + subnum = number' (n `div` 2) + + +esequence = liftM EQLit $ listOf enumber + +eboolean :: Gen Expression +eboolean = sized boolean' + where + boolean' 0 = oneof [return EBTrue, return EBFalse] + boolean' n | n > 0 = oneof [liftM2 EBAnd subbool subbool, + liftM2 EBOr subbool subbool, + liftM EBNot subbool ] where - subbool = liftM EBoolean $ boolean' (n `div` 2) - -eboolean = liftM EBoolean boolean + subbool = boolean' (n `div` 2) expression = oneof [enumber, esequence, eboolean] identifier = elements $ map (Identifier . (:[])) ['a'..'z'] - -pair :: Gen a -> Gen b -> Gen (a, b) -pair = liftM2 (curry id) cspm/tests/HST/CSPM/Tests/Generators.hs @@ -49,7 +49,7 @@ testAll = do prop_NumLiteral i = v1 == v2 where - v1 = eval (ENumber (NLit i)) + v1 = eval (ENLit i) v2 = VNumber i types = i :: Int @@ -57,65 +57,61 @@ prop_NumNeg = forAll enumber tester where tester n = i0 == negate i1 where - VNumber i0 = eval (ENumber (NNeg n)) - VNumber i1 = eval n + i0 = evalAsNumber (ENNeg n) + i1 = evalAsNumber n prop_NumSum = forAll (two enumber) tester where tester (n1, n2) = i0 == i1 + i2 where - VNumber i0 = eval (ENumber (NSum n1 n2)) - VNumber i1 = eval n1 - VNumber i2 = eval n2 + i0 = evalAsNumber (ENSum n1 n2) + i1 = evalAsNumber n1 + i2 = evalAsNumber n2 prop_NumDiff = forAll (two enumber) tester where tester (n1, n2) = i0 == i1 - i2 where - VNumber i0 = eval (ENumber (NDiff n1 n2)) - VNumber i1 = eval n1 - VNumber i2 = eval n2 + i0 = evalAsNumber (ENDiff n1 n2) + i1 = evalAsNumber n1 + i2 = evalAsNumber n2 prop_NumProd = forAll (two enumber) tester where tester (n1, n2) = i0 == i1 * i2 where - VNumber i0 = eval (ENumber (NProd n1 n2)) - VNumber i1 = eval n1 - VNumber i2 = eval n2 + i0 = evalAsNumber (ENProd n1 n2) + i1 = evalAsNumber n1 + i2 = evalAsNumber n2 prop_NumLT = forAll (two enumber) tester where tester (n1, n2) = b0 == (i1 < i2) where - v0 = eval (EBoolean (ELT n1 n2)) - VBoolean b0 = v0 - VNumber i1 = eval n1 - VNumber i2 = eval n2 + b0 = evalAsBoolean (ELT n1 n2) + i1 = evalAsNumber n1 + i2 = evalAsNumber n2 prop_NumGT = forAll (two enumber) tester where tester (n1, n2) = b0 == (i1 > i2) where - v0 = eval (EBoolean (EGT n1 n2)) - VBoolean b0 = v0 - VNumber i1 = eval n1 - VNumber i2 = eval n2 + b0 = evalAsBoolean (EGT n1 n2) + i1 = evalAsNumber n1 + i2 = evalAsNumber n2 prop_NumLTE = forAll (two enumber) tester where tester (n1, n2) = b0 == (i1 <= i2) where - v0 = eval (EBoolean (ELTE n1 n2)) - VBoolean b0 = v0 - VNumber i1 = eval n1 - VNumber i2 = eval n2 + b0 = evalAsBoolean (ELTE n1 n2) + i1 = evalAsNumber n1 + i2 = evalAsNumber n2 prop_NumGTE = forAll (two enumber) tester where tester (n1, n2) = b0 == (i1 >= i2) where - v0 = eval (EBoolean (EGTE n1 n2)) - VBoolean b0 = v0 - VNumber i1 = eval n1 - VNumber i2 = eval n2 + b0 = evalAsBoolean (EGTE n1 n2) + i1 = evalAsNumber n1 + i2 = evalAsNumber n2 cspm/tests/HST/CSPM/Tests/Numbers.hs @@ -41,7 +41,7 @@ prop_SeqLiteral = forAll (listOf enumber) tester where tester ns = q0 == q1 where - q0 = eval (ESequence (QLit ns)) + q0 = eval (EQLit ns) q1 = VSequence (map eval ns) prop_SeqClosedRange = forAll (two enumber) tester @@ -53,31 +53,27 @@ prop_SeqClosedRange = forAll (two enumber) tester -- equality. tester (n1, n2) = (i2 - i1 <= 1000) ==> q0 == q1 where - q0 = eval (ESequence (QClosedRange n1 n2)) + q0 = eval (EQClosedRange n1 n2) q1 = VSequence (map VNumber [i1 .. i2]) - VNumber i1 = eval n1 - VNumber i2 = eval n2 + i1 = evalAsNumber n1 + i2 = evalAsNumber n2 -prop_SeqConcat = forAll (two qsequence) tester +prop_SeqConcat = forAll (two esequence) tester where - tester (ns1, ns2) = v0 == v12 + tester (eq1, eq2) = v0 == v12 where - eq1 = ESequence (QLit ns1) - eq2 = ESequence (QLit ns2) - v0 = eval (ESequence (QConcat eq1 eq2)) - v1 = eval eq1 - v2 = eval eq2 - VSequence q1 = v1 - VSequence q2 = v2 + v0 = eval (EQConcat eq1 eq2) + q1 = evalAsSequence eq1 + q2 = evalAsSequence eq2 v12 = VSequence (q1 ++ q2) -prop_SeqTail = forAll qsequence tester +prop_SeqTail = forAll esequence tester where - tester ns = (length ns > 0) ==> v0 == v1 + tester eq = (length ns > 0) ==> v0 == v1 where - eq0 = ESequence (QTail eq1) - eq1 = ESequence (QLit ns) - v0 = eval eq0 - v1' = eval eq1 - VSequence q1' = v1' - v1 = VSequence (tail q1') \ No newline at end of file + eq0 = EQTail eq + v0 = eval eq0 + + EQLit ns = eq + eq1 = EQLit (tail ns) + v1 = eval eq1 cspm/tests/HST/CSPM/Tests/Sequences.hs @@ -33,18 +33,12 @@ testAll = do quickCheck prop_SetLiteral putStr "SetClosedRange: " quickCheck prop_SetClosedRange -{- - putStr "SetConcat: " - quickCheck prop_SetConcat - putStr "SetTail: " - quickCheck prop_SetTail --} prop_SetLiteral = forAll (listOf enumber) tester where tester ns = s0 == s1 where - s0 = eval (ESet (SLit ns)) + s0 = eval (ESLit ns) s1 = VSet (nub (map eval ns)) prop_SetClosedRange = forAll (two enumber) tester @@ -56,33 +50,7 @@ prop_SetClosedRange = forAll (two enumber) tester -- equality. tester (n1, n2) = (i2 - i1 <= 1000) ==> s0 == s1 where - s0 = eval (ESet (SClosedRange n1 n2)) + s0 = eval (ESClosedRange n1 n2) s1 = VSet (map VNumber [i1 .. i2]) - VNumber i1 = eval n1 - VNumber i2 = eval n2 - -{- -prop_SetConcat = forAll (two esequence) tester - where - tester (ns1, ns2) = v0 == v12 - where - eq1 = ESet (QLit ns1) - eq2 = ESet (QLit ns2) - v0 = eval (ESet (QConcat eq1 eq2)) - v1 = eval eq1 - v2 = eval eq2 - VSet q1 = v1 - VSet q2 = v2 - v12 = VSet (q1 ++ q2) - -prop_SetTail = forAll esequence tester - where - tester ns = (length ns > 0) ==> v0 == v1 - where - eq0 = ESet (QTail eq1) - eq1 = ESet (QLit ns) - v0 = eval eq0 - v1' = eval eq1 - VSet q1' = v1' - v1 = VSet (tail q1') --} + i1 = evalAsNumber n1 + i2 = evalAsNumber n2 cspm/tests/HST/CSPM/Tests/Sets.hs 2a3f31e387e7b41c1856ff79a47ad5bfebdea5cc Douglas Creager dcreager@alum.mit.edu http://github.com/dcreager/hst/commit/37739ef6e867fa53cb039c707bf15d4e1affd1ba 37739ef6e867fa53cb039c707bf15d4e1affd1ba 2008-08-30T13:50:01-07:00 2008-08-30T13:47:18-07:00 Flattening the Expression type Before, we had separate datatypes for each “class” of expression; for instance, a Number type for any expression that always evaluates to a number. The Expression type was then defined as a sum type across all of these subtypes. This patch flattens things so that there's only a single Expression type. This simplifies things by removing a level of indirection in the type definitions, and also will make it easier to define “bound expressions” as we implement static-scoped environments. Lighthouse: [#11] bd66e4392f5dfff3c5111189e23ac2cde766155b Douglas Creager dcreager@alum.mit.edu