hnock

commit 8e8fbb4662a078811a0ea78a84ba3bf8af04310b
parent 98e9a45cb47a5040a028d720db0ed953a109e3c5
Author: Jared Tobin <jared@jtobin.ca>
Date:   Fri, 13 Jul 2018 11:17:04 +1200

Add a simple parser.

Diffstat:
M
hnock.cabal
 | 
11
+++++++++--
M
lib/Nock/Eval.hs
 | 
11
++++++-----
M
lib/Nock/Language.hs
 | 
24
+++++++++++++-----------
A
lib/Nock/Parse.hs
 | 
67
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

4 files changed, 95 insertions(+), 18 deletions(-)
diff --git a/hnock.cabal b/hnock.cabal
@@ -14,8 +14,15 @@ cabal-version:       >=1.10
 
 library
   default-language:    Haskell2010
+  ghc-options:         -Wall
   hs-source-dirs:      lib
-  exposed-modules:     Nock
+  exposed-modules:
+      Nock
+      Nock.Eval
+      Nock.Language
+      Nock.Parse
   build-depends:
-      base >= 4.8 && < 4.12
+      base   >= 4.8      && < 4.12
+    , parsec >= 3.1.13.0 && < 3.2
+    , text   >= 1.2.3.0  && < 1.3
 
diff --git a/lib/Nock/Eval.hs b/lib/Nock/Eval.hs
@@ -8,11 +8,12 @@ import Nock.Language
 nock :: Expr -> Noun
 nock expr = case expr of
   Noun noun -> noun
-  Wut  e -> wut (nock e)
-  Lus  e -> lus (nock e)
-  Tis  e -> tis (nock e)
-  Fas  e -> fas (nock e)
-  Tar  e -> tar (nock e)
+  Pair l r  -> Cell (nock l) (nock r)
+  Wut  e    -> wut (nock e)
+  Lus  e    -> lus (nock e)
+  Tis  e    -> tis (nock e)
+  Fas  e    -> fas (nock e)
+  Tar  e    -> tar (nock e)
 
 wut :: Noun -> Noun
 wut noun = case noun of
diff --git a/lib/Nock/Language.hs b/lib/Nock/Language.hs
@@ -16,19 +16,21 @@ instance Show Noun where
 
 data Expr =
     Noun !Noun
-  | Wut !Expr
-  | Lus !Expr
-  | Tis !Expr
-  | Fas !Expr
-  | Tar !Expr
+  | Pair Expr Expr
+  | Wut Expr
+  | Lus Expr
+  | Tis Expr
+  | Fas Expr
+  | Tar Expr
   deriving Eq
 
 instance Show Expr where
   show op = case op of
-    Noun n -> show n
-    Wut n  -> mconcat ["?", show n]
-    Lus n  -> mconcat ["+", show n]
-    Tis n  -> mconcat ["=", show n]
-    Fas n  -> mconcat ["/", show n]
-    Tar n  -> mconcat ["*", show n]
+    Noun n   -> show n
+    Pair l r -> mconcat ["[", show l, " ", show r, "]"]
+    Wut n    -> mconcat ["?", show n]
+    Lus n    -> mconcat ["+", show n]
+    Tis n    -> mconcat ["=", show n]
+    Fas n    -> mconcat ["/", show n]
+    Tar n    -> mconcat ["*", show n]
 
diff --git a/lib/Nock/Parse.hs b/lib/Nock/Parse.hs
@@ -0,0 +1,67 @@
+{-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Nock.Parse (
+    parse
+  ) where
+
+import Nock.Language
+import qualified Text.Parsec as P
+import qualified Data.Text as T
+import Control.Applicative ((<|>))
+
+parse :: T.Text -> Either P.ParseError Expr
+parse = P.runParser expr [] "input"
+
+expr :: Monad m => P.ParsecT T.Text u m Expr
+expr =
+      P.try operator
+  <|> P.try cell
+  <|> atom
+
+atom :: Monad m => P.ParsecT T.Text u m Expr
+atom = do
+  digits <- P.many P.digit
+  case digits of
+    (h:t) -> case h of
+      '0' -> case t of
+        [] -> return (Noun (Atom 0))
+        _  -> fail "atom: bad parse"
+
+      _   ->
+        let nat = read digits
+        in  return (Noun (Atom nat))
+
+    [] -> fail "atom: bad parse"
+
+operator :: Monad m => P.ParsecT T.Text u m Expr
+operator = do
+  op <- P.oneOf "?+=/*"
+  case op of
+    '?' -> fmap Wut expr
+    '+' -> fmap Lus expr
+    '=' -> fmap Tis expr
+    '/' -> fmap Fas expr
+    '*' -> fmap Tar expr
+    _   -> fail "op: bad token"
+
+cell :: Monad m => P.ParsecT T.Text u m Expr
+cell = do
+  P.char '['
+  P.skipMany P.space
+  leader <- expr
+  P.skipMany P.space
+  rest <- P.sepBy expr (P.many1 P.space)
+  P.skipMany P.space
+  P.char ']'
+
+  return (toPair (leader : rest))
+
+toPair :: [Expr] -> Expr
+toPair = loop where
+  loop list = case list of
+    []     -> error "cell: bad parse"
+    [_]    -> error "cell: bad parse"
+    [s, f] -> Pair s f
+    (h:t)  -> Pair h (loop t)
+