quote and eval, toward macros

This commit is contained in:
Yann Esposito (Yogsototh) 2017-04-23 00:17:08 +02:00
parent a0ca892fef
commit 9076115af5
Signed by untrusted user who does not match committer: yogsototh
GPG key ID: 7B19A4C650D59646
3 changed files with 28 additions and 14 deletions

View file

@ -1,11 +1,14 @@
;; This is lish core (comment This is lish core)
(def require (fn [x] (eval (str "(do " (cat x) ")")))) (def require (fn [x] (eval (str "(do " (cat x) ")"))))
;; increment
(def inc (fn [x] (+ x 1))) (def inc (fn [x] (+ x 1)))
;; map (def range (fn [from to]
(if (< from to)
(cons from (range (inc from) to))
[])))
(def map (fn [f lst] (def map (fn [f lst]
(if (empty? lst) (if (empty? lst)
[] []

View file

@ -138,7 +138,7 @@ fn _ _ = return Void
strictCommands :: [(Text,ReduceUnawareCommand)] strictCommands :: [(Text,ReduceUnawareCommand)]
strictCommands = [ ("prn", prn) strictCommands = [ ("prn", prn)
, ("pr", pr) , ("pr", pr)
, (">", toWaitingStream) , ("<-", toWaitingStream)
, ("replace", replace) , ("replace", replace)
, ("undef",undef) , ("undef",undef)
, ("str",str) , ("str",str)
@ -282,6 +282,22 @@ getenv r (expr:_) = do
_ -> evalErr "getenv need on atom or a string as argument" _ -> evalErr "getenv need on atom or a string as argument"
getenv _ _ = evalErr "getenv need on atom or a string as argument" getenv _ _ = evalErr "getenv need on atom or a string as argument"
comment :: Command
comment _ _ = return Void
quote :: Command
quote _ exprs = return (List (map Fix exprs))
evalList :: Command
evalList r (List exprs:[]) = r (Lambda exprs)
evalList r (x@(Atom _):[]) = do
evaluated <- r x
evalList r [evaluated]
evalList r (x@(Lambda _):[]) = do
evaluated <- r x
evalList r [evaluated]
evalList _ x = evalErr ("Waiting for a list of exprs got: " <> toS (show x))
unstrictCommands :: [(Text,InternalCommand)] unstrictCommands :: [(Text,InternalCommand)]
unstrictCommands = [ ("if", InternalCommand "if" lishIf) unstrictCommands = [ ("if", InternalCommand "if" lishIf)
, ("def", InternalCommand "def" def) , ("def", InternalCommand "def" def)
@ -289,9 +305,12 @@ unstrictCommands = [ ("if", InternalCommand "if" lishIf)
, ("do", InternalCommand "do" doCommand) , ("do", InternalCommand "do" doCommand)
, ("=", InternalCommand "=" equal) , ("=", InternalCommand "=" equal)
, ("export", InternalCommand "export" export) , ("export", InternalCommand "export" export)
, ("eval", InternalCommand "eval" evalStr) , ("quote", InternalCommand "quote" quote)
, ("eval-str", InternalCommand "eval-str" evalStr)
, ("eval", InternalCommand "eval" evalList)
, ("getenv", InternalCommand "getenv" getenv) , ("getenv", InternalCommand "getenv" getenv)
, ("$", InternalCommand "$" getenv) , ("$", InternalCommand "$" getenv)
, ("comment", InternalCommand "comment" comment)
-- list ops -- list ops
, ("empty?",InternalCommand "empty?" emptyCmd) , ("empty?",InternalCommand "empty?" emptyCmd)
, ("first",InternalCommand "first" firstCmd) , ("first",InternalCommand "first" firstCmd)

View file

@ -6,7 +6,6 @@ module Lish.Parser
where where
import Data.Fix import Data.Fix
import qualified Data.Text as Text
import Protolude hiding (for, many, optional, try, (<|>)) import Protolude hiding (for, many, optional, try, (<|>))
import Text.Parsec import Text.Parsec
import Text.Parsec.Text import Text.Parsec.Text
@ -14,14 +13,7 @@ import Text.Parsec.Text
import Lish.Types import Lish.Types
parseCmd :: Text -> Either ParseError Expr parseCmd :: Text -> Either ParseError Expr
parseCmd = parse parseExpr "S-Expr" . Text.strip . eatComment parseCmd = parse parseExpr "S-Expr"
eatComment :: Text -> Text
eatComment t =
t
& Text.lines
& map (Text.takeWhile (/= ';'))
& Text.intercalate "\n"
parseExpr :: Parser Expr parseExpr :: Parser Expr
parseExpr = parseLambda parseExpr = parseLambda