commit 9b4a85c26f7ee18899845eb8c23594843f1ff865
parent 8fb7666f7994a95cd78b365a51ca3cc13da55080
Author: Jared Tobin <jared@jtobin.io>
Date: Wed, 30 Jan 2019 11:50:32 +1300
Update to Nock 4K.
* Bump stackage LTS version
* Add a .ghci file
Diffstat:
7 files changed, 85 insertions(+), 77 deletions(-)
diff --git a/.ghci b/.ghci
@@ -0,0 +1,2 @@
+:set -XOverloadedStrings
+:set prompt "~ "
diff --git a/hnock.cabal b/hnock.cabal
@@ -22,7 +22,7 @@ library
Nock.Language
Nock.Parse
build-depends:
- base >= 4.8 && < 4.12
+ base >= 4.12 && < 5
, parsec >= 3.1.13.0 && < 3.2
, text >= 1.2.3.0 && < 1.3
@@ -32,7 +32,7 @@ executable hnock
hs-source-dirs: src
Main-is: Main.hs
build-depends:
- base >= 4.8 && < 4.12
+ base >= 4.12
, hnock
, text >= 1.2.3.0 && < 1.3
@@ -43,6 +43,6 @@ Test-suite hnock-test
hs-source-dirs: test
Main-is: Main.hs
build-depends:
- base >= 4.8 && < 4.12
+ base >= 4.12
, hnock
diff --git a/lib/Nock/Eval.hs b/lib/Nock/Eval.hs
@@ -19,7 +19,8 @@ eval expr = case expr of
Wut e -> wut e
Lus e -> lus e
Tis e -> tis e
- Fas e -> fas e
+ Net e -> net e
+ Hax e -> hax e
Tar e -> tar e
wut :: Noun -> Possibly Noun
@@ -40,22 +41,37 @@ tis noun = case noun of
then Atom 0
else Atom 1
-fas :: Noun -> Possibly Noun
-fas noun = case noun of
+net :: Noun -> Possibly Noun
+net noun = case noun of
Cell (Atom 1) a -> return a
Cell (Atom 2) (Cell a _) -> return a
Cell (Atom 3) (Cell _ b) -> return b
Cell (Atom a) b ->
if even a
then do
- inner <- fas (Cell (Atom (a `div` 2)) b)
- fas (Cell (Atom 2) inner)
+ inner <- net (Cell (Atom (a `div` 2)) b)
+ net (Cell (Atom 2) inner)
else do
- inner <- fas (Cell (Atom ((a - 1) `div` 2)) b)
- fas (Cell (Atom 3) inner)
+ inner <- net (Cell (Atom ((a - 1) `div` 2)) b)
+ net (Cell (Atom 3) inner)
_ -> Left (Error noun)
+hax :: Noun -> Possibly Noun
+hax noun = case noun of
+ Cell (Atom 1) (Cell a _) -> return a
+ Cell (Atom a) (Cell b c) ->
+ if even a
+ then do
+ let e = a `div` 2
+ inner <- net (Cell (Atom (e + e + 1)) c)
+ hax (Cell (Atom e) (Cell (Cell b inner) c))
+ else do
+ let o = (a - 1) `div` 2
+ inner <- net (Cell (Atom (o + o)) c)
+ hax (Cell (Atom o) (Cell (Cell inner b) c))
+ _ -> Left (Error noun)
+
tar :: Noun -> Possibly Noun
tar noun = case noun of
Cell a (Cell (Cell b c) d) -> do
@@ -64,7 +80,7 @@ tar noun = case noun of
return (Cell inner0 inner1)
Cell a (Cell (Atom 0) b) ->
- fas (Cell b a)
+ net (Cell b a)
Cell _ (Cell (Atom 1) b) ->
return b
@@ -82,68 +98,42 @@ tar noun = case noun of
tard <- tar (Cell a b)
lus tard
- Cell a (Cell (Atom 5) b) -> do
- tard <- tar (Cell a b)
- tis tard
+ Cell a (Cell (Atom 5) (Cell b c)) -> do
+ tard0 <- tar (Cell a b)
+ tard1 <- tar (Cell a c)
+ tis (Cell tard0 tard1)
- Cell a (Cell (Atom 6) (Cell b (Cell c d))) ->
- tar6 a b c d
+ Cell a (Cell (Atom 6) (Cell b (Cell c d))) -> do
+ tard0 <- tar (Cell a (Cell (Atom 4) (Cell (Atom 4) b)))
+ tard1 <- tar (Cell (Cell (Atom 2) (Atom 3)) (Cell (Atom 0) tard0))
+ tard2 <- tar (Cell (Cell c d) (Cell (Atom 0) tard1))
+ tar (Cell a tard2)
- Cell a (Cell (Atom 7) (Cell b c)) ->
- tar (Cell a (Cell (Atom 2) (Cell b (Cell (Atom 1) c))))
+ Cell a (Cell (Atom 7) (Cell b c)) -> do
+ tard <- tar (Cell a b)
+ tar (Cell tard c)
- Cell a (Cell (Atom 8) (Cell b c)) ->
- tar8 a b c
+ Cell a (Cell (Atom 8) (Cell b c)) -> do
+ tard <- tar (Cell a b)
+ tar (Cell (Cell tard a) c)
- Cell a (Cell (Atom 9) (Cell b c)) ->
- tar9 a b c
+ Cell a (Cell (Atom 9) (Cell b c)) -> do
+ tard <- tar (Cell a c)
+ tar (Cell tard
+ (Cell (Atom 2) (Cell (Cell (Atom 0) (Atom 1)) (Cell (Atom 0) b))))
- Cell a (Cell (Atom 10) (Cell (Cell b c) d)) ->
- tar10 a b c d
+ Cell a (Cell (Atom 10) (Cell (Cell b c) d)) -> do
+ tard0 <- tar (Cell a c)
+ tard1 <- tar (Cell a d)
+ hax (Cell b (Cell tard0 tard1))
- Cell a (Cell (Atom 10) (Cell _ c)) ->
+ Cell a (Cell (Atom 11) (Cell (Cell _ c) d)) -> do
+ tard0 <- tar (Cell a c)
+ tard1 <- tar (Cell a d)
+ tar (Cell (Cell tard0 tard1) (Cell (Atom 0) (Atom 3)))
+
+ Cell a (Cell (Atom 11) (Cell _ c)) ->
tar (Cell a c)
_ -> Left (Error noun)
-tar6 :: Noun -> Noun -> Noun -> Noun -> Possibly Noun
-tar6 a b c d = tar $
- Cell a
- (Cell (Atom 2)
- (Cell (Cell (Atom 0) (Atom 1))
- (Cell (Atom 2)
- (Cell (Cell (Atom 1) (Cell c d))
- (Cell (Cell (Atom 1) (Atom 0))
- (Cell (Atom 2)
- (Cell (Cell (Atom 1) (Cell (Atom 2) (Atom 3)))
- (Cell (Cell (Atom 1) (Atom 0))
- (Cell (Atom 4)
- (Cell (Atom 4) b))))))))))
-
-tar8 :: Noun -> Noun -> Noun -> Possibly Noun
-tar8 a b c = tar $
- Cell a
- (Cell (Atom 7)
- (Cell
- (Cell (Atom 7)
- (Cell (Cell (Atom 0) (Atom 1)) b))
- (Cell (Cell (Atom 0) (Atom 1)) c)))
-
-tar9 :: Noun -> Noun -> Noun -> Possibly Noun
-tar9 a b c = tar $
- Cell a
- (Cell (Atom 7)
- (Cell c
- (Cell (Atom 2)
- (Cell (Cell (Atom 0) (Atom 1))
- (Cell (Atom 0) b)))))
-
-tar10 :: Noun -> Noun -> Noun -> Noun -> Possibly Noun
-tar10 a _ c d = tar $
- Cell a
- (Cell (Atom 8)
- (Cell c
- (Cell (Atom 7)
- (Cell (Cell (Atom 0) (Atom 3))
- d))))
-
diff --git a/lib/Nock/Language.hs b/lib/Nock/Language.hs
@@ -18,7 +18,8 @@ data Expr =
| Wut !Noun
| Lus !Noun
| Tis !Noun
- | Fas !Noun
+ | Net !Noun
+ | Hax !Noun
| Tar !Noun
deriving Eq
@@ -28,6 +29,7 @@ instance Show Expr where
Wut n -> mconcat ["?", show n]
Lus n -> mconcat ["+", show n]
Tis n -> mconcat ["=", show n]
- Fas n -> mconcat ["/", show n]
+ Net n -> mconcat ["/", show n]
+ Hax n -> mconcat ["#", show n]
Tar n -> mconcat ["*", show n]
diff --git a/lib/Nock/Parse.hs b/lib/Nock/Parse.hs
@@ -23,12 +23,13 @@ expr =
operator :: Monad m => P.ParsecT T.Text u m Expr
operator = do
- op <- P.oneOf "?+=/*"
+ op <- P.oneOf "?+=/#*"
case op of
'?' -> fmap Wut noun
'+' -> fmap Lus noun
'=' -> fmap Tis noun
- '/' -> fmap Fas noun
+ '/' -> fmap Net noun
+ '#' -> fmap Hax noun
'*' -> fmap Tar noun
_ -> fail "op: bad token"
@@ -44,13 +45,13 @@ atom = do
(h:t) -> case h of
'0' -> case t of
[] -> return (Atom 0)
- _ -> fail "atom: bad parse"
+ _ -> fail "atom: bad input"
_ ->
let nat = read digits
in return (Atom nat)
- [] -> fail "atom: bad parse"
+ [] -> fail "atom: bad input"
cell :: Monad m => P.ParsecT T.Text u m Noun
cell = do
@@ -67,8 +68,8 @@ cell = do
toCell :: [Noun] -> Noun
toCell = loop where
loop list = case list of
- [] -> error "cell: bad parse"
- [_] -> error "cell: bad parse"
+ [] -> error "cell: bad input"
+ [_] -> error "cell: bad input"
[s, f] -> Cell s f
(h:t) -> Cell h (loop t)
diff --git a/stack.yaml b/stack.yaml
@@ -1,3 +1,3 @@
-resolver: lts-12.0
+resolver: lts-13.4
packages:
- .
diff --git a/test/Main.hs b/test/Main.hs
@@ -6,7 +6,7 @@ import Nock
-- should be [6 [14 15]]
expr0 :: Expr
expr0 =
- Fas
+ Net
(Cell (Atom 3)
(Cell (Cell (Atom 4) (Atom 5))
(Cell (Atom 6) (Cell (Atom 14) (Atom 15)))))
@@ -66,7 +66,7 @@ noun4 = Atom 20
-- should be [14 15]
expr5 :: Expr
expr5 =
- Fas
+ Net
(Cell (Atom 7)
(Cell (Cell (Atom 4) (Atom 5))
(Cell (Atom 6) (Cell (Atom 14) (Atom 15)))))
@@ -89,6 +89,18 @@ expr6 =
noun6 :: Noun
noun6 = Cell (Atom 153) (Atom 218)
+-- #[4 11 [[22 33] 44]]
+-- should be [[11 33] 44]
+expr7 :: Expr
+expr7 =
+ Hax
+ (Cell (Atom 4)
+ (Cell (Atom 11)
+ (Cell (Cell (Atom 22) (Atom 33)) (Atom 44))))
+
+noun7 :: Noun
+noun7 = Cell (Cell (Atom 11) (Atom 33)) (Atom 44)
+
main :: IO ()
main = do
print (fmap (== noun0) (eval expr0))
@@ -98,4 +110,5 @@ main = do
print (fmap (== noun4) (eval expr4))
print (fmap (== noun5) (eval expr5))
print (fmap (== noun6) (eval expr6))
+ print (fmap (== noun7) (eval expr7))
