packages feed

hsnock 0.2.0 → 0.3.1

raw patch · 4 files changed

+54/−46 lines, 4 files

Files

Language/Nock5K/Repl.hs view
@@ -2,8 +2,8 @@  import Language.Nock5K.Parse import Language.Nock5K.Spec-import qualified Control.Exception as C import System.Console.Readline+import System.IO import Text.ParserCombinators.Parsec  repl = do ln <- readline "nock "@@ -12,8 +12,10 @@             Just "exit" -> return ()             Just s -> do addHistory s                          case parse noun "" s of-                           Left e -> print e+                           Left e -> (sep . show) e                            Right n -> ep n                          repl-  where-    ep n = (print . nock) n `C.catch` (\e -> print (e :: C.SomeException))+  where ep n = case nock n of+           Left e -> sep e+           Right n -> print n+        sep e = hPutStrLn stderr $ "error: " ++ e
Language/Nock5K/Spec.lhs view
@@ -1,5 +1,6 @@  > module Language.Nock5K.Spec where+> import Control.Monad.Instances  1 Structures @@ -7,13 +8,14 @@   A cell is an ordered pair of nouns.  > data Noun = Atom Integer | Noun :- Noun deriving (Eq)+> type Comp = Either String   2 Reductions    nock(a)           *a -> nock :: Noun -> Noun+> nock :: Noun -> Comp Noun > nock = tar    [a b c]           [a [b c]]@@ -23,63 +25,68 @@    ?[a b]            0 -> wut (a :- b) = Atom 0+> wut (a :- b) = return $ Atom 0    ?a                1 -> wut a = Atom 1+> wut a = return $ Atom 1    +[a b]            +[a b] -> lus (a :- b) = error "+[a b]"+> lus (a :- b) = Left "+[a b]"    +a                1 + a -> lus (Atom a) = Atom (1 + a)+> lus (Atom a) = return $ Atom (1 + a)    =[a a]            0 -> tis (a :- a') | a == a' = Atom 0+> tis (a :- a') | a == a' = return $ Atom 0    =[a b]            1 -> tis (a :- b) = Atom 1+> tis (a :- b) = return $ Atom 1    =a                =a -> tis a = error "=a"+> tis a = Left "=a"     /[1 a]            a -> fas (Atom 1 :- a) = a+> fas (Atom 1 :- a) = return a    /[2 a b]          a -> fas (Atom 2 :- a :- b) = a+> fas (Atom 2 :- a :- b) = return a    /[3 a b]          b -> fas (Atom 3 :- a :- b) = b+> fas (Atom 3 :- a :- b) = return b    /[(a + a) b]      /[2 /[a b]] -> fas (Atom a :- b) | a > 2 && a `mod` 2 == 0 =->   fas $ Atom 2 :- fas (Atom (a `div` 2) :- b)+> fas (Atom a :- b) | a > 2 && a `mod` 2 == 0 = do+>   x <- fas $ Atom (a `div` 2) :- b+>   fas $ Atom 2 :- x    /[(a + a + 1) b]  /[3 /[a b]] -> fas (Atom a :- b) | a > 3 && a `mod` 2 == 1 =->   fas $ Atom 3 :- fas (Atom (a `div` 2) :- b)+> fas (Atom a :- b) | a > 3 && a `mod` 2 == 1 = do+>   x <- fas $ Atom (a `div` 2) :- b+>   fas $ Atom 3 :- x    /a                /a -> fas a = error "/a"+> fas a = Left "/a"     *[a [b c] d]      [*[a b c] *[a d]] -> tar (a :- (b :- c) :- d) = tar (a :- b :- c) :- tar (a :- d)+> tar (a :- (b :- c) :- d) = do+>   x <- tar (a :- b :- c)+>   y <- tar (a :- d)+>   return $ x :- y     *[a 0 b]          /[b a]@@ -88,23 +95,26 @@    *[a 1 b]          b -> tar (a :- (Atom 1 :- b)) = b+> tar (a :- (Atom 1 :- b)) = return b    *[a 2 b c]        *[*[a b] *[a c]] -> tar (a :- Atom 2 :- b :- c) = tar $ tar (a :- b) :- tar (a :- c)+> tar (a :- Atom 2 :- b :- c) = do+>   x <- tar (a :- b)+>   y <- tar (a :- c)+>   tar $ x :- y    *[a 3 b]          ?*[a b] -> tar (a :- Atom 3 :- b) = (wut.tar) (a :- b)+> tar (a :- Atom 3 :- b) = tar (a :- b) >>= wut    *[a 4 b]          +*[a b] -> tar (a :- Atom 4 :- b) = (lus.tar) (a :- b)+> tar (a :- Atom 4 :- b) = tar (a :- b) >>= lus    *[a 5 b]          =*[a b] -> tar (a :- Atom 5 :- b) = (tis.tar) (a :- b)+> tar (a :- Atom 5 :- b) = tar (a :- b) >>= tis     *[a 6 b c d]      *[a 2 [0 1] 2 [1 c d] [1 0] 2 [1 2 3] [1 0] 4 4 b]@@ -141,4 +151,4 @@    *a                *a -> tar a = error "*a"+> tar a = Left "*a"
hsnock.cabal view
@@ -1,5 +1,5 @@ name                 : hsnock-version              : 0.2.0+version              : 0.3.1 category             : Language license              : PublicDomain synopsis             : Nock 5K interpreter.
test.hs view
@@ -9,8 +9,6 @@ import Text.ParserCombinators.Parsec (parse) import Text.Printf -main = defaultMain tests- instance Arbitrary Noun where   arbitrary = choose (0, 32) >>= arbD     where@@ -18,37 +16,35 @@       arbD 0 = (Atom . abs) <$> arbitrary       arbD n = do coin <- arbitrary                   if coin-                    then (Atom . abs) <$> arbitrary+                    then arbD 0                     else (:-) <$> arbD (n - 1) <*> arbD (n - 1) -parsenoun n = case parse noun "" n of-  Left e -> error "parse"-  Right n -> n+pn n = case parse noun "" n of Right n -> n -prop_parse_show n = n == (parsenoun . show) n+prop_parse_show n = n == (pn . show) n -prop_dec a' = nock (Atom (a + 1) :- dec) == Atom a+prop_dec a' = nock (Atom (a + 1) :- dec) == (Right $ Atom a)   where     ds = "[8 [1 0] 8 [1 6 [5 [0 7] 4 0 6] [0 6] 9 2 [0 2] [4 0 6] 0 7] 9 2 0 1]"-    dec = parsenoun ds+    dec = pn ds     a = abs a' -prop_6_is_if a' b = nock (ifs $ Atom 0) == Atom (a + 1) && nock (ifs $ Atom 1) == b+prop_6_is_if a' b = nock (ifs $ Atom 0) == Right (Atom (a + 1)) && nock (ifs $ Atom 1) == Right b   where     ifs c = Atom a :- Atom 6 :- (Atom 1 :- c) :- (Atom 4 :- Atom 0 :- Atom 1) :- (Atom 1 :- b)     a = abs a' -test_hint_crash =-  C.catch (nock bad `seq` assertFailure "Hint not evaluated")-          (\e -> do let se = show (e :: C.ErrorCall)-                    if se == "/a"-                      then return ()-                      else assertFailure $ "Exception: " ++ se)- where-  bad = Atom 42 :- Atom 10 :- (Atom 0 :- Atom 0 :- Atom 2) :- Atom 0 :- Atom 1+test_hint_crash = assert $ nock bad == Left "/a"+  where bad = pn "[42 10 [0 0 2] 0 1]" +test_eval_strict = assert $ nock bad == Left "/a"+  where bad = pn "[0 2 [0 2] 1 1 42]"+ tests = [ testProperty "parse.show"    prop_parse_show         , testProperty "decrement"     prop_dec         , testProperty "6_is_if"       prop_6_is_if         , testCase     "10_hint_crash" test_hint_crash+        , testCase     "eval_strict"   test_eval_strict         ]++main = defaultMain tests