msyds/rlp
1
0
Fork 0
Code Issues 4 Pull Requests Actions Packages Projects Releases 2 Wiki Activity

arith fixes

Browse Source
This commit is contained in:
crumbtoo
2023-12-13 11:35:09 -07:00
parent 906bdc59b7
commit c03b2a5473
1 changed files with 10 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
tst/Arith.hs
View File

@@ -35,7 +35,7 @@ instance Arbitrary ArithExpr where
gen :: Int -> Gen ArithExpr gen :: Int -> Gen ArithExpr
gen n gen n
| n > 0 = oneof | n > 0 = oneof
-- i don't feel like dealing with zero at the moment -- i don't feel like dealing with division at the moment
[ IntA <$> int [ IntA <$> int
, NegateA <$> arbitrary , NegateA <$> arbitrary
-- , IdA <$> arbitrary -- , IdA <$> arbitrary
@@ -47,7 +47,8 @@ instance Arbitrary ArithExpr where
where where
b f = liftA2 f s s b f = liftA2 f s s
s = gen (n `div` 2) s = gen (n `div` 2)
int = chooseInt (minBound,maxBound) -- int = chooseInt (minBound,maxBound)
int = chooseInt (-500,500)
prop_ArithExprEqCoreExpr :: ArithExpr -> Bool prop_ArithExprEqCoreExpr :: ArithExpr -> Bool
prop_ArithExprEqCoreExpr e = arithResult `eq1` coreResult prop_ArithExprEqCoreExpr e = arithResult `eq1` coreResult
@@ -55,23 +56,23 @@ prop_ArithExprEqCoreExpr e = arithResult `eq1` coreResult
arithResult = Just (evalA e) arithResult = Just (evalA e)
coreResult = evalCore (toCore e) coreResult = evalCore (toCore e)
toCore :: ArithExpr -> Program toCore :: ArithExpr -> Program'
toCore expr = Program toCore expr = Program
[ ScDef "id" ["x"] $ Var "x" [ ScDef "id" ["x"] $ Var "x"
, ScDef "main" [] $ go expr , ScDef "main" [] $ go expr
] ]
where where
go :: ArithExpr -> Expr go :: ArithExpr -> Expr'
go (IntA n) = IntE n go (IntA n) = LitE (IntL n)
go (NegateA e) = "negate#" :$ go e go (NegateA e) = "negate#" :$ go e
go (IdA e) = "id" :$ go e go (IdA e) = "id" :$ go e
go (a :+ b) = f "+#" a b go (a :+ b) = f "+#" a b
go (a :- b) = f "-#" a b go (a :- b) = f "-#" a b
go (a :* b) = f "*#" a b go (a :* b) = f "*#" a b
f n a b = n :$ go a :$ go b f n a b = n :$ go a :$ go b
evalCore :: Program -> Maybe Int evalCore :: Program' -> Maybe Int
evalCore p = do evalCore p = do
a <- fst <$> evalProg p a <- fst <$> evalProg p
case a of case a of