mirror of
https://github.com/mrdomino/hsnock.git
synced 2024-10-05 17:47:44 +03:00
Collapse the fas recursive cases together
This "obviously" works. Just in case, I've added a check.
This commit is contained in:
parent
f070f57a9b
commit
2c33b12f83
@ -57,14 +57,12 @@ tis a = Left "=a"
|
|||||||
\/[(a + a + 1) b] \/[3 \/[a b]]
|
\/[(a + a + 1) b] \/[3 \/[a b]]
|
||||||
\/a \/a
|
\/a \/a
|
||||||
@-}
|
@-}
|
||||||
fas (Atom 1 :- a) = return a
|
fas (Atom 1 :- a) = return a
|
||||||
fas (Atom 2 :- a :- b) = return a
|
fas (Atom 2 :- a :- b) = return a
|
||||||
fas (Atom 3 :- a :- b) = return b
|
fas (Atom 3 :- a :- b) = return b
|
||||||
fas (Atom a :- b) | a > 2 && a `mod` 2 == 0 = do x <- fas $ Atom (a `div` 2) :- b
|
fas (Atom a :- b) | a > 3 = do x <- fas $ Atom (a `div` 2) :- b
|
||||||
fas $ Atom 2 :- x
|
fas $ Atom (2 + (a `mod` 2)) :- x
|
||||||
fas (Atom a :- b) | a > 3 && a `mod` 2 == 1 = do x <- fas $ Atom (a `div` 2) :- b
|
fas a = Left "/a"
|
||||||
fas $ Atom 3 :- x
|
|
||||||
fas a = Left "/a"
|
|
||||||
|
|
||||||
{-|@
|
{-|@
|
||||||
\*[a [b c] d] [\*[a b c] \*[a d]]
|
\*[a [b c] d] [\*[a b c] \*[a d]]
|
||||||
|
7
test.hs
7
test.hs
@ -34,6 +34,12 @@ prop_6_is_if a' b = nock (ifs $ Atom 0) == Right (Atom (a + 1)) && nock (ifs $ A
|
|||||||
ifs c = Atom a :- Atom 6 :- (Atom 1 :- c) :- (Atom 4 :- Atom 0 :- Atom 1) :- (Atom 1 :- b)
|
ifs c = Atom a :- Atom 6 :- (Atom 1 :- c) :- (Atom 4 :- Atom 0 :- Atom 1) :- (Atom 1 :- b)
|
||||||
a = abs a'
|
a = abs a'
|
||||||
|
|
||||||
|
prop_fas_induct a' b = fas (a + a) b == fasmn 2 a b && fas (a + a + 1) b == fasmn 3 a b
|
||||||
|
where fas c d = nock $ d :- Atom c
|
||||||
|
fasmn m n c = do x <- fas n c
|
||||||
|
fas m x
|
||||||
|
a = abs a'
|
||||||
|
|
||||||
test_hint_crash = assert $ nock bad == Left "/a"
|
test_hint_crash = assert $ nock bad == Left "/a"
|
||||||
where bad = pn "[42 10 [0 0 2] 0 1]"
|
where bad = pn "[42 10 [0 0 2] 0 1]"
|
||||||
|
|
||||||
@ -43,6 +49,7 @@ test_eval_strict = assert $ nock bad == Left "/a"
|
|||||||
tests = [ testProperty "parse.show" prop_parse_show
|
tests = [ testProperty "parse.show" prop_parse_show
|
||||||
, testProperty "decrement" prop_dec
|
, testProperty "decrement" prop_dec
|
||||||
, testProperty "6_is_if" prop_6_is_if
|
, testProperty "6_is_if" prop_6_is_if
|
||||||
|
, testProperty "fas_induct" prop_fas_induct
|
||||||
, testCase "10_hint_crash" test_hint_crash
|
, testCase "10_hint_crash" test_hint_crash
|
||||||
, testCase "eval_strict" test_eval_strict
|
, testCase "eval_strict" test_eval_strict
|
||||||
]
|
]
|
||||||
|
Loading…
Reference in New Issue
Block a user