module Core exposing (..)
-import Types exposing (MalExpr(..), MalFunction(..), Eval, Env, keywordPrefix)
+import Types exposing (..)
import Env
import Eval
import Printer exposing (printString)
import IO exposing (IO(..))
import Reader
import Utils exposing (zip)
+import Time
+import Task
ns : Env
Eval.fail "unsupported arguments"
gc args =
- Eval.withEnv (Env.gc >> Printer.printEnv >> writeLine)
+ Eval.withEnv (Env.gc MalNil >> Printer.printEnv >> writeLine)
setDebug enabled =
Eval.modifyEnv
debug args =
case args of
- [ MalBool True ] ->
- setDebug True
+ [ MalBool value ] ->
+ setDebug value
_ ->
- setDebug False
+ Eval.withEnv
+ (\env ->
+ Eval.succeed (MalBool env.debug)
+ )
typeof args =
case args of
throw args =
case args of
- [ MalString msg ] ->
- Eval.fail msg
+ ex :: _ ->
+ Eval.throw ex
_ ->
Eval.fail "undefined exception"
apply args =
case args of
(MalFunction func) :: rest ->
- callFn func rest
+ case List.reverse rest of
+ (MalList last) :: middle ->
+ callFn func ((List.reverse middle) ++ last)
+
+ (MalVector last) :: middle ->
+ callFn func
+ ((List.reverse middle)
+ ++ (Array.toList last)
+ )
+
+ _ ->
+ Eval.fail "apply expected the last argument to be a list or vector"
_ ->
Eval.fail "unsupported arguments"
callFn func [ inv ]
|> Eval.andThen
(\outv ->
- go func rest (outv :: acc)
+ Eval.pushRef outv (go func rest (outv :: acc))
)
in
case args of
[ MalFunction func, MalList list ] ->
- go func list []
+ Eval.withStack (go func list [])
[ MalFunction func, MalVector vec ] ->
go func (Array.toList vec) []
_ ->
False
+ isNumber args =
+ Eval.succeed <|
+ MalBool <|
+ case args of
+ (MalInt _) :: _ ->
+ True
+
+ _ ->
+ False
+
isSymbol args =
Eval.succeed <|
MalBool <|
_ ->
False
+ isString args =
+ Eval.succeed <|
+ MalBool <|
+ case args of
+ (MalString _) :: _ ->
+ True
+
+ _ ->
+ False
+
+ isSequential args =
+ Eval.succeed <|
+ MalBool <|
+ case args of
+ (MalList _) :: _ ->
+ True
+
+ (MalVector _) :: _ ->
+ True
+
+ _ ->
+ False
+
+ isFn args =
+ Eval.succeed <|
+ MalBool <|
+ case args of
+ (MalFunction (CoreFunc _)) :: _ ->
+ True
+ (MalFunction (UserFunc fn)) :: _ ->
+ if fn.isMacro then
+ False
+ else
+ True
+
+ _ ->
+ False
+
+ isMacro args =
+ Eval.succeed <|
+ MalBool <|
+ case args of
+ (MalFunction (UserFunc fn)) :: _ ->
+ if fn.isMacro then
+ True
+ else
+ False
+
+ _ ->
+ False
+
symbol args =
case args of
[ MalString str ] ->
_ ->
Eval.fail "unsupported arguments"
+
+ readLine args =
+ case args of
+ [ MalString prompt ] ->
+ Eval.io (IO.readLine prompt)
+ (\msg ->
+ case msg of
+ LineRead (Just line) ->
+ Eval.succeed (MalString line)
+
+ LineRead Nothing ->
+ Eval.succeed MalNil
+
+ _ ->
+ Eval.fail "wrong IO, expected LineRead"
+ )
+
+ _ ->
+ Eval.fail "unsupported arguments"
+
+ withMeta args =
+ case args of
+ [ MalFunction (UserFunc func), meta ] ->
+ Eval.succeed <| MalFunction <| UserFunc { func | meta = Just meta }
+
+ _ ->
+ Eval.fail "with-meta expected a user function and a map"
+
+ meta args =
+ case args of
+ [ MalFunction (UserFunc { meta }) ] ->
+ Eval.succeed (Maybe.withDefault MalNil meta)
+
+ _ ->
+ Eval.succeed MalNil
+
+ conj args =
+ case args of
+ (MalList list) :: rest ->
+ Eval.succeed <|
+ MalList <|
+ (List.reverse rest)
+ ++ list
+
+ (MalVector vec) :: rest ->
+ Eval.succeed <|
+ MalVector <|
+ Array.append
+ vec
+ (Array.fromList rest)
+
+ _ ->
+ Eval.fail "unsupported arguments"
+
+ seq args =
+ case args of
+ [ MalNil ] ->
+ Eval.succeed MalNil
+
+ [ MalList [] ] ->
+ Eval.succeed MalNil
+
+ [ MalString "" ] ->
+ Eval.succeed MalNil
+
+ [ (MalList _) as list ] ->
+ Eval.succeed list
+
+ [ MalVector vec ] ->
+ Eval.succeed <|
+ if Array.isEmpty vec then
+ MalNil
+ else
+ MalList <| Array.toList vec
+
+ [ MalString str ] ->
+ Eval.succeed <|
+ MalList <|
+ (String.toList str
+ |> List.map String.fromChar
+ |> List.map MalString
+ )
+
+ _ ->
+ Eval.fail "unsupported arguments"
+
+ requestTime =
+ Task.perform (GotTime >> Ok >> Input) Time.now
+
+ timeMs args =
+ case args of
+ [] ->
+ Eval.io requestTime
+ (\msg ->
+ case msg of
+ GotTime time ->
+ Time.inMilliseconds time
+ |> floor
+ |> MalInt
+ |> Eval.succeed
+
+ _ ->
+ Eval.fail "wrong IO, expected GotTime"
+ )
+
+ _ ->
+ Eval.fail "time-ms takes no arguments"
in
Env.global
|> Env.set "+" (makeFn <| binaryOp (+) MalInt)
|> Env.set "first" (makeFn first)
|> Env.set "rest" (makeFn rest)
|> Env.set "throw" (makeFn throw)
+ |> Env.set "apply" (makeFn apply)
+ |> Env.set "map" (makeFn map)
|> Env.set "nil?" (makeFn isNil)
|> Env.set "true?" (makeFn isTrue)
|> Env.set "false?" (makeFn isFalse)
+ |> Env.set "number?" (makeFn isNumber)
|> Env.set "symbol?" (makeFn isSymbol)
|> Env.set "keyword?" (makeFn isKeyword)
|> Env.set "vector?" (makeFn isVector)
|> Env.set "map?" (makeFn isMap)
+ |> Env.set "string?" (makeFn isString)
+ |> Env.set "sequential?" (makeFn isSequential)
+ |> Env.set "fn?" (makeFn isFn)
+ |> Env.set "macro?" (makeFn isMacro)
|> Env.set "symbol" (makeFn symbol)
|> Env.set "keyword" (makeFn keyword)
|> Env.set "vector" (makeFn vector)
|> Env.set "contains?" (makeFn contains)
|> Env.set "keys" (makeFn keys)
|> Env.set "vals" (makeFn vals)
+ |> Env.set "readline" (makeFn readLine)
+ |> Env.set "with-meta" (makeFn withMeta)
+ |> Env.set "meta" (makeFn meta)
+ |> Env.set "conj" (makeFn conj)
+ |> Env.set "seq" (makeFn seq)
+ |> Env.set "time-ms" (makeFn timeMs)
HCoop / jackhill / mal.git / blobdiff