wip

lish/core.lsh

@@ -0,0 +1,11 @@
+;; This is lish core
+
+;; increment
+def inc (fn [x] (+ x 1))
+
+;; map
+def map (fn [f lst]
+          (if (empty? lst)
+            []
+            (cons (f (first lst))
+                  (map f (rest lst)))))

src-test/Lish/Test/Parser.hs

@@ -5,6 +5,7 @@ where
 
 import Protolude
 
+import Prelude (String)
 import Data.Fix
 import Test.Tasty
 import Test.Tasty.HUnit
@@ -18,15 +19,24 @@ parseTests =
   [ testCase "simple commands" (simpleCommand "ls")
   , testCase "simple commands" (simpleCommand "atom")
   , testCase "simple commands" (simpleCommand "_foo")
+  , testCase "multiline command"
+             (parseCmd "fn [x] ; comment \n   (+ x 1)" @?= Right incExpr)
   , testProperty "simple" propAtom
   ]
 
+incExpr :: Expr
+incExpr = Fix (Lambda [Fix (Atom "fn")
+                      ,Fix (List [Fix (Atom "x")])
+                      ,Fix (Lambda [Fix (Atom "+")
+                                   ,Fix (Atom "x")
+                                   ,Fix (Num 1)])])
+
 simpleCommand :: Text -> Assertion
 simpleCommand t = parseCmd t @?= Right (Fix (Atom t))
 
-propAtom :: [Char] -> Bool
+propAtom :: String -> Bool
 propAtom s = s == "" ||
-  fromMaybe '0' (head s) `elem` ("0123456789([])" :: [Char]) ||
+  fromMaybe '0' (head s) `elem` ("0123456789([])" :: String) ||
   case s of
   "true" -> parseCmd t == Right (Fix (Bool True))
   "false" -> parseCmd t == Right (Fix (Bool False))

src/Lish/InternalCommands.hs

@@ -261,20 +261,19 @@ export r (n:value:[]) = do
   export r (n:reducedVal:[])
 export _ _ = evalErr $ "eval need an atom and a string (eval foo \"foo\")"
 
--- ## TODO
+evalStr :: Command
--- eval :: Command
+evalStr r ((Str program):[]) = do
--- eval r ((Str program):[]) = do
+  let parsed = parseCmd program
---   let parsed = parseCmd program
+  case parsed of
---   case parsed of
+    Right expr -> r (unFix expr)
---     Right expr -> r (unFix expr)
+    _          -> evalErr "evalStr error"
---     _          -> evalErr "eval error"
+evalStr r (x@(Atom _):[]) = do
--- eval r (x@(Atom _):[]) = do
+  reduced <- r x
---   reduced <- r x
+  evalStr r (reduced:[])
---   eval r (reduced:[])
+evalStr r (x@(Lambda _):[]) = do
--- eval r (x@(Lambda _):[]) = do
+  reduced <- r x
---   reduced <- r x
+  evalStr r (reduced:[])
---   eval r (reduced:[])
+evalStr _ _ = evalErr "evalStr error"
--- eval _ _ = evalErr "eval error"
 
 unstrictCommands :: [(Text,InternalCommand)]
 unstrictCommands = [ ("if", InternalCommand "if" lishIf)

src/Lish/Parser.hs

@@ -14,14 +14,14 @@ import           Text.Parsec.Text
 import           Lish.Types
 
 parseCmd :: Text -> Either ParseError Expr
-parseCmd = parse parseExpr "S-Expr" . eatComment
+parseCmd = parse parseExpr "S-Expr" . Text.strip . eatComment
 
 eatComment :: Text -> Text
 eatComment t =
   t
   & Text.lines
   & map (Text.takeWhile (/= ';'))
-  & Text.unlines
+  & Text.intercalate "\n"
 
 parseExpr :: Parser Expr
 parseExpr = parseLambda