hsnock (empty) → 0.1.3

raw patch · 9 files changed

+285/−0 lines, 9 filesdep +QuickCheckdep +basedep +parsecsetup-changed

Dependencies added: QuickCheck, base, parsec, readline

Files

Language/Nock5K.hs +5/−0
Language/Nock5K/Parse.hs +23/−0
Language/Nock5K/Repl.hs +19/−0
Language/Nock5K/Spec.lhs +144/−0
README +13/−0
Setup.hs +2/−0
hsnock.cabal +38/−0
hsnock.lhs +3/−0
test.hs +38/−0

+ Language/Nock5K.hs view

@@ -0,0 +1,5 @@+module Language.Nock5K (Noun(Atom, (:-)), nock, noun, repl) where++import Language.Nock5K.Parse+import Language.Nock5K.Repl+import Language.Nock5K.Spec

+ Language/Nock5K/Parse.hs view

@@ -0,0 +1,23 @@+module Language.Nock5K.Parse where++import Control.Applicative ((<$>))+import Language.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 = (Atom . read) <$> many1 digit++cell :: Parser Noun+cell = foldr1 (:-) <$> (noun `sepBy2` char ' ') `surroundBy` "[]"+  where+    p `sepBy2` sep = do { a <- p; sep; bs <- p `sepBy1` sep; return (a:bs) }+    p `surroundBy` (s:e:_) = do { char s; a <- p; char e; return a }

+ Language/Nock5K/Repl.hs view

@@ -0,0 +1,19 @@+module Language.Nock5K.Repl where++import Language.Nock5K.Parse+import Language.Nock5K.Spec+import qualified Control.Exception as C+import System.Console.Readline+import Text.ParserCombinators.Parsec++repl = do ln <- readline "nock "+          case ln of+            Nothing     -> return ()+            Just "exit" -> return ()+            Just s -> do addHistory s+                         case parse noun "" s of+                           Left e -> print e+                           Right n -> ep n+                         repl+  where+    ep n = (print . nock) n `C.catch` (\e -> print (e :: C.SomeException))

+ Language/Nock5K/Spec.lhs view

@@ -0,0 +1,144 @@++> module Language.Nock5K.Spec 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 :- a') | a == a' = 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"

+ README view

@@ -0,0 +1,13 @@+Usage:+./hsnock.lhs++Try forms like:+[42 1 0]+[42 0 1]+[[1 3 2] 0 3]+[42 [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]]+[[42 43] [8 [1 0] [8 [1 [6 [5 [0 6] [0 14]] [1 0] [6 [5 [0 6] [0 15]] [1 1] [9 2 [[0 2] [4 0 6] [0 7]]]]]] [9 2 0 1]]]]+[[43 42] [8 [1 0] [8 [1 [6 [5 [0 6] [0 14]] [1 0] [6 [5 [0 6] [0 15]] [1 1] [9 2 [[0 2] [4 0 6] [0 7]]]]]] [9 2 0 1]]]]++See also:+http://www.urbit.org/2013/08/22/Chapter-2-nock.html

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ hsnock.cabal view

@@ -0,0 +1,38 @@+name                 : hsnock+version              : 0.1.3+category             : Language+license              : PublicDomain+synopsis             : Nock 5K interpreter.+author               : Steven Dee+maintainer           : mrdomino@gmail.com+homepage             : https://github.com/mrdomino/hsnock/++build-type           : Simple+cabal-version        : >=1.8+data-files           : README++source-repository      head+  type               : git+  location           : https://github.com/mrdomino/hsnock.git++library+  build-depends      : base >=4.5 && <5+                     , parsec >=3.1+                     , readline >=1.0+  exposed-modules    : Language.Nock5K+                     , Language.Nock5K.Parse+                     , Language.Nock5K.Spec+                     , Language.Nock5K.Repl++executable             hsnock+  main-is            : hsnock.lhs+  build-depends      : base >=4.5 && <5+                     , parsec >=3.1+                     , readline >=1.0++test-suite test+  type               : exitcode-stdio-1.0+  main-is            : test.hs+  build-depends      : base >=4.5 && <5+                     , parsec >=3.1+                     , QuickCheck >=2.6

+ hsnock.lhs view

@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Language.Nock5K+> main = repl

+ test.hs view

@@ -0,0 +1,38 @@+import Control.Applicative+import Language.Nock5K+import Test.QuickCheck+import Text.ParserCombinators.Parsec (parse)+import Text.Printf++main = mapM_ (\(s,a) -> printf "%-25s: " s >> a) tests++instance Arbitrary Noun where+  arbitrary = choose (0, 32) >>= arbD+    where+      arbD :: Int -> Gen Noun+      arbD 0 = (Atom . abs) <$> arbitrary+      arbD n = do coin <- arbitrary+                  if coin+                    then (Atom . abs) <$> arbitrary+                    else (:-) <$> arbD (n - 1) <*> arbD (n - 1)++parsenoun n = case parse noun "" n of+  Left e -> error "parse"+  Right n -> n++prop_parse_show n = n == (parsenoun . show) n++prop_dec a' = nock (Atom (a + 1) :- dec) == 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+    a = abs a'++prop_6_is_if a' b = nock (ifs $ Atom 0) == Atom (a + 1) && nock (ifs $ Atom 1) == b+  where+    ifs c = Atom a :- Atom 6 :- (Atom 1 :- c) :- (Atom 4 :- Atom 0 :- Atom 1) :- (Atom 1 :- b)+    a = abs a'++tests = [("parse_show", quickCheck prop_parse_show)+        ,("decrement", quickCheck prop_dec)+        ,("6_is_if", quickCheck prop_6_is_if)]