mirror of
https://github.com/mrdomino/hsnock.git
synced 2024-09-11 13:57:42 +03:00
Clean up drastically
This commit is contained in:
Steven Dee
parent
8e09889a70
commit
8f97de9f3d
150
Nock5K.lhs
150
Nock5K.lhs
@ -1,150 +0,0 @@
|
||||
> module Nock5K where
|
||||
|
||||
1 Structures
|
||||
|
||||
A noun is an atom or a cell. An atom is any natural number.
|
||||
A cell is an ordered pair of nouns.
|
||||
|
||||
> data Noun = Atom Integer | Cell Noun Noun deriving (Eq)
|
||||
|
||||
|
||||
2 Reductions
|
||||
|
||||
nock(a) *a
|
||||
|
||||
> nock = tar
|
||||
|
||||
[a b c] [a [b c]]
|
||||
|
||||
> infixr 1 `Cell`
|
||||
|
||||
|
||||
?[a b] 0
|
||||
|
||||
> wut (Cell a b) = Atom 0
|
||||
|
||||
?a 1
|
||||
|
||||
> wut a = Atom 1
|
||||
|
||||
+[a b] +[a b]
|
||||
|
||||
> lus (Cell a b) = error "+[a b]"
|
||||
|
||||
+a 1 + a
|
||||
|
||||
> lus (Atom a) = Atom (1 + a)
|
||||
|
||||
=[a a] 0
|
||||
|
||||
> tis (Cell a ap) | a == ap = Atom 0
|
||||
|
||||
=[a b] 1
|
||||
|
||||
> tis (Cell a b) = Atom 1
|
||||
|
||||
=a =a
|
||||
|
||||
> tis a = error "=a"
|
||||
|
||||
|
||||
/[1 a] a
|
||||
|
||||
> fas (Cell (Atom 1) a) = a
|
||||
|
||||
/[2 a b] a
|
||||
|
||||
> fas (Cell (Atom 2) (Cell a b)) = a
|
||||
|
||||
/[3 a b] b
|
||||
|
||||
> fas (Cell (Atom 3) (Cell a b)) = b
|
||||
|
||||
/[(a + a) b] /[2 /[a b]]
|
||||
|
||||
> fas (Cell (Atom a) b) | a > 2 && a `mod` 2 == 0 =
|
||||
> fas $ Atom 2 `Cell` (fas $ Atom (a `div` 2) `Cell` b)
|
||||
|
||||
/[(a + a + 1) b] /[3 /[a b]]
|
||||
|
||||
> fas (Cell (Atom a) b) | a > 3 && a `mod` 2 == 1 =
|
||||
> fas $ Atom 3 `Cell` (fas $ Atom (a `div` 2) `Cell` b)
|
||||
|
||||
/a /a
|
||||
|
||||
> fas a = error "/a"
|
||||
|
||||
|
||||
*[a [b c] d] [*[a b c] *[a d]]
|
||||
|
||||
> tar (Cell a (Cell (Cell b c) d)) =
|
||||
> tar (a `Cell` b `Cell` c) `Cell` tar (a `Cell` d)
|
||||
|
||||
|
||||
*[a 0 b] /[b a]
|
||||
|
||||
> tar (Cell a (Cell (Atom 0) b)) = fas $ b `Cell` a
|
||||
|
||||
*[a 1 b] b
|
||||
|
||||
> tar (Cell a (Cell (Atom 1) b)) = b
|
||||
|
||||
*[a 2 b c] *[*[a b] *[a c]]
|
||||
|
||||
> tar (Cell a (Cell (Atom 2) (Cell b c))) =
|
||||
> tar $ (tar (Cell a b)) `Cell` (tar (Cell a c))
|
||||
|
||||
*[a 3 b] ?*[a b]
|
||||
|
||||
> tar (Cell a (Cell (Atom 3) b)) = (wut.tar) (Cell a b)
|
||||
|
||||
*[a 4 b] +*[a b]
|
||||
|
||||
> tar (Cell a (Cell (Atom 4) b)) = (lus.tar) (Cell a b)
|
||||
|
||||
*[a 5 b] =*[a b]
|
||||
|
||||
> tar (Cell a (Cell (Atom 5) b)) = (tis.tar) (Cell a b)
|
||||
|
||||
|
||||
*[a 6 b c d] *[a 2 [0 1] 2 [1 c d] [1 0] 2 [1 2 3] [1 0] 4 4 b]
|
||||
|
||||
> tar (Cell a (Cell (Atom 6) (Cell b (Cell c d)))) =
|
||||
> tar (a `Cell` Atom 2 `Cell` (Atom 0 `Cell` Atom 1) `Cell`
|
||||
> Atom 2 `Cell` (Atom 1 `Cell` c `Cell` d) `Cell`
|
||||
> (Atom 1 `Cell` Atom 0) `Cell` (Atom 2) `Cell`
|
||||
> (Atom 1 `Cell` Atom 2 `Cell` Atom 3) `Cell`
|
||||
> (Atom 1 `Cell` Atom 0) `Cell` Atom 4 `Cell` Atom 4 `Cell` b)
|
||||
|
||||
*[a 7 b c] *[a 2 b 1 c]
|
||||
|
||||
> tar (Cell a (Cell (Atom 7) (Cell b c))) =
|
||||
> tar $ a `Cell` Atom 2 `Cell` b `Cell` Atom 1 `Cell` c
|
||||
|
||||
*[a 8 b c] *[a 7 [[7 [0 1] b] 0 1] c]
|
||||
|
||||
> tar (Cell a (Cell (Atom 8) (Cell b c))) =
|
||||
> tar (a `Cell` Atom 7 `Cell`
|
||||
> ((Atom 7 `Cell` (Atom 0 `Cell` Atom 1) `Cell` b) `Cell`
|
||||
> Atom 0 `Cell` Atom 1) `Cell` c)
|
||||
|
||||
*[a 9 b c] *[a 7 c 2 [0 1] 0 b]
|
||||
|
||||
> tar (Cell a (Cell (Atom 9) (Cell b c))) =
|
||||
> tar (a `Cell` Atom 7 `Cell` c `Cell` Atom 2 `Cell`
|
||||
> (Atom 0 `Cell` Atom 1) `Cell` Atom 0 `Cell` b)
|
||||
|
||||
*[a 10 [b c] d] *[a 8 c 7 [0 3] d]
|
||||
|
||||
> tar (Cell a (Cell (Atom 10) (Cell (Cell b c) d))) =
|
||||
> tar (a `Cell` Atom 8 `Cell` c `Cell` Atom 7 `Cell`
|
||||
> (Atom 0 `Cell` Atom 3) `Cell` d)
|
||||
|
||||
*[a 10 b c] *[a c]
|
||||
|
||||
> tar (Cell a (Cell (Atom 10) (Cell b c))) = tar $ a `Cell` c
|
||||
|
||||
|
||||
*a *a
|
||||
|
||||
> tar a = error "*a"
|
||||
25
Nock5K/Parse.hs
Executable file
25
Nock5K/Parse.hs
Executable file
@ -0,0 +1,25 @@
|
||||
module Nock5K.Parse (noun) where
|
||||
|
||||
import Nock5K.Spec
|
||||
import Text.ParserCombinators.Parsec
|
||||
|
||||
instance Show Noun where
|
||||
show (Atom a) = show a
|
||||
show x@(_ :- _) = "[" ++ showCell x ++ "]"
|
||||
where showCell (a :- b) = show a ++ " " ++ showCell b
|
||||
showCell a = show a
|
||||
|
||||
noun :: Parser Noun
|
||||
noun = atom <|> cell
|
||||
|
||||
atom :: Parser Noun
|
||||
atom = many1 digit >>= (return . Atom . read)
|
||||
|
||||
cell :: Parser Noun
|
||||
cell = do
|
||||
char '['
|
||||
a <- noun
|
||||
char ' '
|
||||
bs <- noun `sepBy1` char ' '
|
||||
char ']'
|
||||
return $ foldr1 (:-) (a:bs)
|
||||
143
Nock5K/Spec.lhs
Normal file
143
Nock5K/Spec.lhs
Normal file
@ -0,0 +1,143 @@
|
||||
> module Nock5K.Spec (Noun (Atom, (:-)), nock) where
|
||||
|
||||
1 Structures
|
||||
|
||||
A noun is an atom or a cell. An atom is any natural number.
|
||||
A cell is an ordered pair of nouns.
|
||||
|
||||
> data Noun = Atom Integer | Noun :- Noun deriving (Eq)
|
||||
|
||||
|
||||
2 Reductions
|
||||
|
||||
nock(a) *a
|
||||
|
||||
> nock :: Noun -> Noun
|
||||
> nock = tar
|
||||
|
||||
[a b c] [a [b c]]
|
||||
|
||||
> infixr 1 :-
|
||||
|
||||
|
||||
?[a b] 0
|
||||
|
||||
> wut (a :- b) = Atom 0
|
||||
|
||||
?a 1
|
||||
|
||||
> wut a = Atom 1
|
||||
|
||||
+[a b] +[a b]
|
||||
|
||||
> lus (a :- b) = error "+[a b]"
|
||||
|
||||
+a 1 + a
|
||||
|
||||
> lus (Atom a) = Atom (1 + a)
|
||||
|
||||
=[a a] 0
|
||||
|
||||
> tis (a :- ap) | a == ap = Atom 0
|
||||
|
||||
=[a b] 1
|
||||
|
||||
> tis (a :- b) = Atom 1
|
||||
|
||||
=a =a
|
||||
|
||||
> tis a = error "=a"
|
||||
|
||||
|
||||
/[1 a] a
|
||||
|
||||
> fas (Atom 1 :- a) = a
|
||||
|
||||
/[2 a b] a
|
||||
|
||||
> fas (Atom 2 :- a :- b) = a
|
||||
|
||||
/[3 a b] b
|
||||
|
||||
> fas (Atom 3 :- a :- b) = 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)
|
||||
|
||||
/[(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)
|
||||
|
||||
/a /a
|
||||
|
||||
> fas a = error "/a"
|
||||
|
||||
|
||||
*[a [b c] d] [*[a b c] *[a d]]
|
||||
|
||||
> tar (a :- (b :- c) :- d) = tar (a :- b :- c) :- tar (a :- d)
|
||||
|
||||
|
||||
*[a 0 b] /[b a]
|
||||
|
||||
> tar (a :- (Atom 0 :- b)) = fas $ b :- a
|
||||
|
||||
*[a 1 b] b
|
||||
|
||||
> tar (a :- (Atom 1 :- b)) = b
|
||||
|
||||
*[a 2 b c] *[*[a b] *[a c]]
|
||||
|
||||
> tar (a :- Atom 2 :- b :- c) = tar $ tar (a :- b) :- tar (a :- c)
|
||||
|
||||
*[a 3 b] ?*[a b]
|
||||
|
||||
> tar (a :- Atom 3 :- b) = (wut.tar) (a :- b)
|
||||
|
||||
*[a 4 b] +*[a b]
|
||||
|
||||
> tar (a :- Atom 4 :- b) = (lus.tar) (a :- b)
|
||||
|
||||
*[a 5 b] =*[a b]
|
||||
|
||||
> tar (a :- Atom 5 :- b) = (tis.tar) (a :- b)
|
||||
|
||||
|
||||
*[a 6 b c d] *[a 2 [0 1] 2 [1 c d] [1 0] 2 [1 2 3] [1 0] 4 4 b]
|
||||
|
||||
> tar (a :- Atom 6 :- b :- c :- d) =
|
||||
> tar (a :- Atom 2 :- (Atom 0 :- Atom 1) :- Atom 2 :- (Atom 1 :- c :- d) :-
|
||||
> (Atom 1 :- Atom 0) :- (Atom 2) :- (Atom 1 :- Atom 2 :- Atom 3) :-
|
||||
> (Atom 1 :- Atom 0) :- Atom 4 :- Atom 4 :- b)
|
||||
|
||||
*[a 7 b c] *[a 2 b 1 c]
|
||||
|
||||
> tar (a :- Atom 7 :- b :- c) = tar $ a :- Atom 2 :- b :- Atom 1 :- c
|
||||
|
||||
*[a 8 b c] *[a 7 [[7 [0 1] b] 0 1] c]
|
||||
|
||||
> tar (a :- Atom 8 :- b :- c) =
|
||||
> tar (a :- Atom 7 :- ((Atom 7 :- (Atom 0 :- Atom 1) :- b) :-
|
||||
> Atom 0 :- Atom 1) :- c)
|
||||
|
||||
*[a 9 b c] *[a 7 c 2 [0 1] 0 b]
|
||||
|
||||
> tar (a :- Atom 9 :- b :- c) =
|
||||
> tar (a :- Atom 7 :- c :- Atom 2 :- (Atom 0 :- Atom 1) :- Atom 0 :- b)
|
||||
|
||||
*[a 10 [b c] d] *[a 8 c 7 [0 3] d]
|
||||
|
||||
> tar (a :- Atom 10 :- (b :- c) :- d) =
|
||||
> tar (a :- Atom 8 :- c :- Atom 7 :- (Atom 0 :- Atom 3) :- d)
|
||||
|
||||
*[a 10 b c] *[a c]
|
||||
|
||||
> tar (a :- Atom 10 :- b :- c) = tar $ a :- c
|
||||
|
||||
|
||||
*a *a
|
||||
|
||||
> tar a = error "*a"
|
||||
63
nock.hs
63
nock.hs
@ -1,51 +1,26 @@
|
||||
#!/usr/bin/env runhaskell
|
||||
|
||||
import Nock5K
|
||||
import Prelude hiding (catch)
|
||||
|
||||
import System.IO (hPrint, stderr)
|
||||
import Text.ParserCombinators.Parsec (
|
||||
(<|>), Parser, char, digit, many1, oneOf, optionMaybe, parse, sepBy1)
|
||||
import Nock5K.Parse
|
||||
import Nock5K.Spec
|
||||
|
||||
instance Show Noun where
|
||||
show (Atom a) = show a
|
||||
show x@(Cell _ _) = "[" ++ showCell x ++ "]"
|
||||
where showCell (Cell a b) = show a ++ " " ++ showCell b
|
||||
showCell a = show a
|
||||
import Control.Exception (SomeException, catch)
|
||||
import Control.Monad (forever)
|
||||
import System.IO (hFlush, hPrint, stderr, stdout)
|
||||
import Text.ParserCombinators.Parsec (parse)
|
||||
|
||||
doop :: Char -> Noun -> Noun
|
||||
doop '?' = wut
|
||||
doop '+' = lus
|
||||
doop '=' = tis
|
||||
doop '/' = fas
|
||||
doop '*' = tar
|
||||
doop _ = error "op"
|
||||
|
||||
stmt :: Parser (Maybe Char, Noun)
|
||||
stmt = do
|
||||
o <- optionMaybe $ oneOf "?+=/*"
|
||||
n <- noun
|
||||
return (o, n)
|
||||
|
||||
noun :: Parser Noun
|
||||
noun = atom <|> cell
|
||||
|
||||
atom :: Parser Noun
|
||||
atom = many1 digit >>= (return . Atom . read)
|
||||
|
||||
cell :: Parser Noun
|
||||
cell = do
|
||||
char '['
|
||||
a <- noun
|
||||
char ' '
|
||||
bs <- noun `sepBy1` char ' '
|
||||
char ']'
|
||||
return $ foldr1 Cell (a:bs)
|
||||
repl :: IO ()
|
||||
repl = forever rep
|
||||
where
|
||||
rep = do putStr "nock "
|
||||
hFlush stdout
|
||||
ln <- getLine
|
||||
case parse noun "stdin" ln of
|
||||
Left pe -> hPrint stderr pe
|
||||
Right n -> ep n
|
||||
ep n = catch ((print . nock) n)
|
||||
(\ioe -> hPrint stderr (ioe :: SomeException) >> repl)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
ln <- getLine
|
||||
case (parse stmt "" ln) of
|
||||
Left pe -> hPrint stderr pe
|
||||
Right (o,n) -> case o of
|
||||
Nothing -> print n
|
||||
Just op -> print $ doop op n
|
||||
main = repl
|
||||
|
||||
Loading…
Reference in New Issue
Block a user