Elm: part 4 halfway finished. Hello Monads.

elm/Core.elm

@@ -0,0 +1,121 @@
+module Core exposing (..)
+
+import Types exposing (MalExpr(..), Eval, Env)
+import Env
+import Eval
+import Printer exposing (printString)
+import Array
+import IO exposing (IO(..))
+
+
+ns : Env
+ns =
+    let
+        binaryOp fn retType args =
+            case args of
+                [ MalInt x, MalInt y ] ->
+                    Eval.succeed (retType (fn x y))
+
+                _ ->
+                    Eval.fail "unsupported arguments"
+
+        {- list -}
+        list =
+            Eval.succeed << MalList
+
+        {- list? -}
+        isList args =
+            case args of
+                [ MalList _ ] ->
+                    Eval.succeed (MalBool True)
+
+                _ ->
+                    Eval.succeed (MalBool False)
+
+        {- empty? -}
+        isEmpty args =
+            case args of
+                [ MalList list ] ->
+                    Eval.succeed <| MalBool (List.isEmpty list)
+
+                [ MalVector vec ] ->
+                    Eval.succeed <| MalBool (Array.isEmpty vec)
+
+                _ ->
+                    Eval.fail "unsupported arguments"
+
+        {- count -}
+        count args =
+            case args of
+                [ MalList list ] ->
+                    Eval.succeed <| MalInt (List.length list)
+
+                [ MalVector vec ] ->
+                    Eval.succeed <| MalInt (Array.length vec)
+
+                _ ->
+                    Eval.fail "unsupported arguments"
+
+        {- = -}
+        equals args =
+            case args of
+                [ a, b ] ->
+                    Eval.succeed <| MalBool (a == b)
+
+                _ ->
+                    Eval.fail "unsupported arguments"
+
+        {- pr-str -}
+        prStr =
+            List.map (printString True)
+                >> String.join " "
+                >> MalString
+                >> Eval.succeed
+
+        {- str -}
+        str =
+            List.map (printString False)
+                >> String.join ""
+                >> MalString
+                >> Eval.succeed
+
+        writeLine str =
+            Eval.io (IO.writeLine str)
+                (\msg ->
+                    case msg of
+                        LineWritten ->
+                            -- TODO need caller continuation here...
+                            Eval.succeed MalNil
+
+                        _ ->
+                            Eval.fail "wrong IO, expected LineWritten"
+                )
+
+        prn =
+            List.map (printString True)
+                >> String.join " "
+                >> writeLine
+
+        println =
+            List.map (printString False)
+                >> String.join " "
+                >> writeLine
+    in
+        Env.make Nothing
+            |> Env.set "+" (MalFunction <| binaryOp (+) MalInt)
+            |> Env.set "-" (MalFunction <| binaryOp (-) MalInt)
+            |> Env.set "*" (MalFunction <| binaryOp (*) MalInt)
+            |> Env.set "/" (MalFunction <| binaryOp (//) MalInt)
+            |> Env.set "<" (MalFunction <| binaryOp (<) MalBool)
+            |> Env.set ">" (MalFunction <| binaryOp (>) MalBool)
+            |> Env.set "<=" (MalFunction <| binaryOp (<=) MalBool)
+            |> Env.set ">=" (MalFunction <| binaryOp (>=) MalBool)
+            |> Env.set "list" (MalFunction list)
+            |> Env.set "list?" (MalFunction isList)
+            |> Env.set "empty?" (MalFunction isEmpty)
+            |> Env.set "count" (MalFunction count)
+            |> Env.set "=" (MalFunction equals)
+            |> Env.set "pr-str" (MalFunction prStr)
+            |> Env.set "str" (MalFunction str)
+            |> Env.set "prn" (MalFunction prn)
+            |> Env.set "println" (MalFunction println)

elm/Env.elm

@@ -1,16 +1,9 @@
-module Env exposing (Env, make, set, get)
+module Env exposing (make, set, get)
 
-import Types exposing (MalExpr(..))
+import Types exposing (MalExpr(..), Env(..))
 import Dict exposing (Dict)
 
 
-type Env
-    = Env
-        { outer : Maybe Env
-        , data : Dict String MalExpr
-        }
-
-
 make : Maybe Env -> Env
 make outer =
     Env { outer = outer, data = Dict.empty }

elm/Eval.elm

@@ -0,0 +1,90 @@
+module Eval exposing (..)
+
+import Types exposing (..)
+import IO exposing (IO)
+
+
+apply : Eval a -> EvalState -> EvalContext a
+apply (Eval f) state =
+    f state
+
+
+run : EvalState -> Eval a -> EvalContext a
+run state e =
+    apply e state
+
+
+withState : (EvalState -> Eval a) -> Eval a
+withState f =
+    Eval <|
+        \state ->
+            apply (f state) state
+
+
+putState : EvalState -> Eval ()
+putState state =
+    Eval <|
+        \_ ->
+            apply (succeed ()) state
+
+
+modifyState : (EvalState -> EvalState) -> Eval ()
+modifyState f =
+    Eval <|
+        \state ->
+            apply (succeed ()) (f state)
+
+
+succeed : a -> Eval a
+succeed res =
+    Eval <|
+        \state ->
+            ( state, EvalOk res )
+
+
+io : Cmd Msg -> (IO -> Eval a) -> Eval a
+io cmd cont =
+    Eval <|
+        \state ->
+            ( state, EvalIO cmd cont )
+
+
+map : (a -> b) -> Eval a -> Eval b
+map f e =
+    Eval <|
+        \state ->
+            case apply e state of
+                ( state, EvalOk res ) ->
+                    ( state, EvalOk (f res) )
+
+                ( state, EvalErr msg ) ->
+                    ( state, EvalErr msg )
+
+                ( state, EvalIO cmd cont ) ->
+                    ( state, EvalIO cmd (cont >> map f) )
+
+
+andThen : (a -> Eval b) -> Eval a -> Eval b
+andThen f e =
+    Eval <|
+        \state ->
+            case apply e state of
+                ( state, EvalOk res ) ->
+                    apply (f res) state
+
+                ( state, EvalErr msg ) ->
+                    ( state, EvalErr msg )
+
+                ( state, EvalIO cmd cont ) ->
+                    ( state, EvalIO cmd (cont >> andThen f) )
+
+
+
+-- Debug.log "wrapping EvalIO" ( state, EvalIO cmd cont )
+
+
+fail : String -> Eval a
+fail msg =
+    Eval <|
+        \state ->
+            ( state, EvalErr msg )

elm/IO.elm

@@ -0,0 +1,53 @@
+port module IO
+    exposing
+        ( IO(..)
+        , writeLine
+        , readLine
+        , input
+        , decodeIO
+        )
+
+import Json.Decode exposing (..)
+
+
+{-| Output a string to stdout
+-}
+port writeLine : String -> Cmd msg
+
+
+{-| Read a line from the stdin
+-}
+port readLine : String -> Cmd msg
+
+
+{-| Received a response for a command.
+-}
+port input : (Value -> msg) -> Sub msg
+
+
+type IO
+    = LineRead (Maybe String)
+    | LineWritten
+
+
+decodeIO : Decoder IO
+decodeIO =
+    field "tag" string
+        |> andThen decodeTag
+
+
+decodeTag : String -> Decoder IO
+decodeTag tag =
+    case tag of
+        "lineRead" ->
+            field "line" (nullable string)
+                |> map LineRead
+
+        "lineWritten" ->
+            succeed LineWritten
+
+        _ ->
+            fail <|
+                "Trying to decode IO, but tag "
+                    ++ tag
+                    ++ " is not supported."

elm/Makefile

@@ -1,10 +1,10 @@
-SOURCES_BASE = #reader.ls printer.ls env.ls core.ls utils.ls
-SOURCES_STEPS = step0_repl.elm step1_read_print.elm step2_eval.elm \
-	step3_env.elm # \
-	step4_if_fn_do.ls step5_tco.ls step6_file.ls step7_quote.ls \
-	step8_macros.ls step9_try.ls stepA_mal.ls
+SOURCES_BASE = Reader.elm Printer.elm Utils.elm Types.elm Env.elm \
+	Core.elm Eval.elm IO.elm
+SOURCES_STEPS = step0_repl.elm step4_if_fn_do.elm #step1_read_print.elm step2_eval.elm \
+	step3_env.elm step4_if_fn_do.elm #step5_tco.ls step6_file.ls \
+	step7_quote.ls step8_macros.ls step9_try.ls stepA_mal.ls
 SOURCES_LISP = #env.ls core.ls stepA_mal.ls
-SOURCES = $(SOURCES_BASE) $(SOURCES_STEPS)
+SOURCES = $(SOURCES_STEPS)
 
 BINS = $(SOURCES:%.elm=%.js)
 
@@ -22,9 +22,9 @@ elm_packages:
 	$(ELM) make $(@:%.js=%.elm) --output $@
 
 step1_read_print.js: Reader.elm Printer.elm Utils.elm Types.elm
-step2_eval.js: Reader.elm Printer.elm Utils.elm Types.elm
-step3_env.js: Reader.elm Printer.elm Utils.elm Types.elm Env.elm
-# step4_if_fn_do.js: utils.js reader.js printer.js env.js core.js
+#step2_eval.js: Reader.elm Printer.elm Utils.elm Types.elm
+#step3_env.js: Reader.elm Printer.elm Utils.elm Types.elm Env.elm
+step4_if_fn_do.js: $(SOURCES_BASE)
 # step5_tco.js: utils.js reader.js printer.js env.js core.js
 # step6_file.js: utils.js reader.js printer.js env.js core.js
 # step7_quote.js: utils.js reader.js printer.js env.js core.js

elm/Types.elm

@@ -1,7 +1,42 @@
-module Types exposing (MalExpr(..), keywordPrefix)
+module Types exposing (..)
 
 import Array exposing (Array)
 import Dict exposing (Dict)
+import IO exposing (IO)
+
+
+type Msg
+    = Input (Result String IO)
+
+
+type Env
+    = Env
+        { outer : Maybe Env
+        , data : Dict String MalExpr
+        }
+
+
+type alias EvalState =
+    { env : Env
+    }
+
+
+type EvalResult res
+    = EvalErr String
+    | EvalOk res
+    | EvalIO (Cmd Msg) (IO -> Eval res)
+
+
+type alias EvalContext res =
+    ( EvalState, EvalResult res )
+
+
+type alias EvalFn res =
+    EvalState -> EvalContext res
+
+
+type Eval res
+    = Eval (EvalFn res)
 
 
 type MalExpr
@@ -14,7 +49,7 @@ type MalExpr
     | MalList (List MalExpr)
     | MalVector (Array MalExpr)
     | MalMap (Dict String MalExpr)
-    | MalFunction (List MalExpr -> Result String MalExpr)
+    | MalFunction (List MalExpr -> Eval MalExpr)
 
 
 {-| Keywords are prefixed by this char for usage in a MalMap.

elm/Utils.elm

@@ -6,6 +6,7 @@ module Utils
         , wrap
         , maybeToList
         , zip
+        , last
         )
 
 import Regex exposing (replace, regex, HowMany(All))
@@ -85,3 +86,16 @@ zip a b =
 
         ( x :: xs, y :: ys ) ->
             ( x, y ) :: zip xs ys
+
+
+last : List a -> Maybe a
+last list =
+    case list of
+        [] ->
+            Nothing
+
+        [ x ] ->
+            Just x
+
+        x :: xs ->
+            last xs

elm/bootstrap.js

@@ -9,12 +9,13 @@ var app = mod.Main.worker({
     args: args.slice(1)
 });
 
-// Hook up the output and readLine ports of the app.
-app.ports.output.subscribe(function(line) {
+// Hook up the writeLine and readLine ports of the app.
+app.ports.writeLine.subscribe(function(line) {
     console.log(line);
+    app.ports.input.send({"tag": "lineWritten"});
 });
 
 app.ports.readLine.subscribe(function(prompt) {
     var line = readline.readline(prompt);
-    app.ports.input.send(line);
+    app.ports.input.send({"tag": "lineRead", "line": line});
 });

elm/step0_repl.elm

@@ -1,16 +1,8 @@
 port module Main exposing (..)
 
+import IO exposing (..)
+import Json.Decode exposing (decodeValue)
 import Platform exposing (programWithFlags)
-import Json.Decode
-
-
-port output : String -> Cmd msg
-
-
-port readLine : String -> Cmd msg
-
-
-port input : (Maybe String -> msg) -> Sub msg
 
 
 main : Program Flags Model Msg
@@ -18,7 +10,8 @@ main =
     programWithFlags
         { init = init
         , update = update
-        , subscriptions = \model -> input Input
+        , subscriptions =
+            \model -> input (decodeValue decodeIO >> Input)
         }
 
 
@@ -33,7 +26,7 @@ type alias Model =
 
 
 type Msg
-    = Input (Maybe String)
+    = Input (Result String IO)
 
 
 init : Flags -> ( Model, Cmd Msg )
@@ -44,17 +37,18 @@ init flags =
 update : Msg -> Model -> ( Model, Cmd Msg )
 update msg model =
     case msg of
-        Input (Just line) ->
-            ( model
-            , Cmd.batch
-                [ output (rep line)
-                , readLine prompt
-                ]
-            )
+        Input (Ok (LineRead (Just line))) ->
+            ( model, writeLine (rep line) )
 
-        Input Nothing ->
+        Input (Ok LineWritten) ->
+            ( model, readLine prompt )
+
+        Input (Ok (LineRead Nothing)) ->
             ( model, Cmd.none )
 
+        Input (Err msg) ->
+            Debug.crash msg ( model, Cmd.none )
+
 
 prompt : String
 prompt =

elm/step1_read_print.elm

@@ -1,10 +1,7 @@
 port module Main exposing (..)
 
-{-| Your IDE might complain that the Json.Decode import
-is not used, but it is. Without it you'll get a runtime exception.
--}
-
-import Json.Decode
+import IO exposing (..)
+import Json.Decode exposing (decodeValue)
 import Platform exposing (programWithFlags)
 import Types exposing (MalExpr(..))
 import Reader exposing (readString)
@@ -12,27 +9,13 @@ import Printer exposing (printString)
 import Utils exposing (maybeToList)
 
 
-{-| Output a string to stdout
--}
-port output : String -> Cmd msg
-
-
-{-| Read a line from the stdin
--}
-port readLine : String -> Cmd msg
-
-
-{-| Received a line from the stdin (in response to readLine).
--}
-port input : (Maybe String -> msg) -> Sub msg
-
-
 main : Program Flags Model Msg
 main =
     programWithFlags
         { init = init
         , update = update
-        , subscriptions = \model -> input Input
+        , subscriptions =
+            \model -> input (decodeValue decodeIO >> Input)
         }
 
 
@@ -47,7 +30,7 @@ type alias Model =
 
 
 type Msg
-    = Input (Maybe String)
+    = Input (Result String IO)
 
 
 init : Flags -> ( Model, Cmd Msg )
@@ -58,22 +41,23 @@ init flags =
 update : Msg -> Model -> ( Model, Cmd Msg )
 update msg model =
     case msg of
-        Input (Just line) ->
-            let
-                outputCmd =
-                    rep line |> Maybe.map output
+        Input (Ok (LineRead (Just line))) ->
+            case rep line of
+                Just out ->
+                    ( model, writeLine out )
 
-                -- Don't print output when 'rep' returns Nothing.
-                cmds =
-                    maybeToList outputCmd ++ [ readLine prompt ]
-            in
-                ( model
-                , Cmd.batch cmds
-                )
+                Nothing ->
+                    ( model, readLine prompt )
 
-        Input Nothing ->
+        Input (Ok LineWritten) ->
+            ( model, readLine prompt )
+
+        Input (Ok (LineRead Nothing)) ->
             ( model, Cmd.none )
 
+        Input (Err msg) ->
+            Debug.crash msg ( model, Cmd.none )
+
 
 prompt : String
 prompt =

elm/step2_eval.elm

@@ -1,10 +1,7 @@
 port module Main exposing (..)
 
-{-| Your IDE might complain that the Json.Decode import
-is not used, but it is. Without it you'll get a runtime exception.
--}
-
-import Json.Decode
+import IO exposing (..)
+import Json.Decode exposing (decodeValue)
 import Platform exposing (programWithFlags)
 import Types exposing (MalExpr(..))
 import Reader exposing (readString)
@@ -15,27 +12,13 @@ import Tuple exposing (mapFirst)
 import Array
 
 
-{-| Output a string to stdout
--}
-port output : String -> Cmd msg
-
-
-{-| Read a line from the stdin
--}
-port readLine : String -> Cmd msg
-
-
-{-| Received a line from the stdin (in response to readLine).
--}
-port input : (Maybe String -> msg) -> Sub msg
-
-
 main : Program Flags Model Msg
 main =
     programWithFlags
         { init = init
         , update = update
-        , subscriptions = \model -> input Input
+        , subscriptions =
+            \model -> input (decodeValue decodeIO >> Input)
         }
 
 
@@ -55,7 +38,7 @@ type alias Model =
 
 
 type Msg
-    = Input (Maybe String)
+    = Input (Result String IO)
 
 
 init : Flags -> ( Model, Cmd Msg )
@@ -85,32 +68,32 @@ initReplEnv =
 update : Msg -> Model -> ( Model, Cmd Msg )
 update msg model =
     case msg of
-        Input (Just line) ->
+        Input (Ok (LineRead (Just line))) ->
             case rep model.env line of
                 Nothing ->
                     ( model, readLine prompt )
 
                 Just ( result, newEnv ) ->
-                    ( { model | env = newEnv }
-                    , Cmd.batch
-                        [ makeOutput result
-                        , readLine prompt
-                        ]
-                    )
+                    ( { model | env = newEnv }, writeLine (makeOutput result) )
 
-        Input Nothing ->
+        Input (Ok LineWritten) ->
+            ( model, readLine prompt )
+
+        Input (Ok (LineRead Nothing)) ->
             ( model, Cmd.none )
 
+        Input (Err msg) ->
+            Debug.crash msg ( model, Cmd.none )
 
-makeOutput : Result String String -> Cmd msg
+
+makeOutput : Result String String -> String
 makeOutput result =
-    output <|
-        case result of
-            Ok str ->
-                str
+    case result of
+        Ok str ->
+            str
 
-            Err msg ->
-                "ERR:" ++ msg
+        Err msg ->
+            "ERR:" ++ msg
 
 
 prompt : String

elm/step3_env.elm

@@ -1,10 +1,7 @@
 port module Main exposing (..)
 
-{-| Your IDE might complain that the Json.Decode import
-is not used, but it is. Without it you'll get a runtime exception.
--}
-
-import Json.Decode
+import IO exposing (..)
+import Json.Decode exposing (decodeValue)
 import Platform exposing (programWithFlags)
 import Types exposing (MalExpr(..))
 import Reader exposing (readString)
@@ -16,27 +13,12 @@ import Array
 import Env exposing (Env)
 
 
-{-| Output a string to stdout
--}
-port output : String -> Cmd msg
-
-
-{-| Read a line from the stdin
--}
-port readLine : String -> Cmd msg
-
-
-{-| Received a line from the stdin (in response to readLine).
--}
-port input : (Maybe String -> msg) -> Sub msg
-
-
 main : Program Flags Model Msg
 main =
     programWithFlags
         { init = init
         , update = update
-        , subscriptions = \model -> input Input
+        , subscriptions = \model -> input (decodeValue decodeIO >> Input)
         }
 
 
@@ -52,7 +34,7 @@ type alias Model =
 
 
 type Msg
-    = Input (Maybe String)
+    = Input (Result String IO)
 
 
 init : Flags -> ( Model, Cmd Msg )
@@ -81,32 +63,32 @@ initReplEnv =
 update : Msg -> Model -> ( Model, Cmd Msg )
 update msg model =
     case msg of
-        Input (Just line) ->
+        Input (Ok (LineRead (Just line))) ->
             case rep model.env line of
                 Nothing ->
                     ( model, readLine prompt )
 
                 Just ( result, newEnv ) ->
-                    ( { model | env = newEnv }
-                    , Cmd.batch
-                        [ makeOutput result
-                        , readLine prompt
-                        ]
-                    )
+                    ( { model | env = newEnv }, writeLine (makeOutput result) )
 
-        Input Nothing ->
+        Input (Ok LineWritten) ->
+            ( model, readLine prompt )
+
+        Input (Ok (LineRead Nothing)) ->
             ( model, Cmd.none )
 
+        Input (Err msg) ->
+            Debug.crash msg ( model, Cmd.none )
 
-makeOutput : Result String String -> Cmd msg
+
+makeOutput : Result String String -> String
 makeOutput result =
-    output <|
-        case result of
-            Ok str ->
-                str
+    case result of
+        Ok str ->
+            str
 
-            Err msg ->
-                "ERR:" ++ msg
+        Err msg ->
+            "ERR:" ++ msg
 
 
 prompt : String

elm/step4_if_fn_do.elm

@@ -0,0 +1,395 @@
+port module Main exposing (..)
+
+import Array
+import Dict exposing (Dict)
+import IO exposing (..)
+import Json.Decode exposing (decodeValue)
+import Platform exposing (programWithFlags)
+import Types exposing (..)
+import Reader exposing (readString)
+import Printer exposing (printString)
+import Utils exposing (maybeToList, zip, last)
+import Env
+import Core
+import Eval
+
+
+main : Program Flags Model Msg
+main =
+    programWithFlags
+        { init = init
+        , update = update
+        , subscriptions =
+            \model -> input (decodeValue decodeIO >> Input)
+        }
+
+
+type alias Flags =
+    { args : List String
+    }
+
+
+type alias Model =
+    { args : List String
+    , env : Env
+    , cont : Maybe (IO -> Eval MalExpr)
+    }
+
+
+init : Flags -> ( Model, Cmd Msg )
+init { args } =
+    ( { args = args
+      , env = Core.ns
+      , cont = Nothing
+      }
+    , readLine prompt
+    )
+
+
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg model =
+    case model.cont of
+        Nothing ->
+            normalUpdate msg model
+
+        Just cont ->
+            case msg of
+                Input (Ok io) ->
+                    run { model | cont = Nothing } (cont io)
+
+                Input (Err msg) ->
+                    Debug.crash msg ( model, Cmd.none )
+
+
+normalUpdate : Msg -> Model -> ( Model, Cmd Msg )
+normalUpdate msg model =
+    case msg of
+        Input (Ok (LineRead (Just line))) ->
+            rep line
+                |> Maybe.map (run model)
+                |> Maybe.withDefault (( model, readLine prompt ))
+
+        Input (Ok LineWritten) ->
+            ( model, readLine prompt )
+
+        Input (Ok (LineRead Nothing)) ->
+            ( model, Cmd.none )
+
+        Input (Err msg) ->
+            Debug.crash msg ( model, Cmd.none )
+
+
+run : Model -> Eval MalExpr -> ( Model, Cmd Msg )
+run model e =
+    case Eval.run { env = model.env } e of
+        ( { env }, EvalOk expr ) ->
+            ( { model | env = env }, writeLine (print expr) )
+
+        ( { env }, EvalErr msg ) ->
+            ( { model | env = env }, writeLine ("ERR:" ++ msg) )
+
+        ( { env }, EvalIO cmd cont ) ->
+            ( { model | cont = Just cont }, cmd )
+
+
+makeOutput : Result String String -> String
+makeOutput result =
+    case result of
+        Ok str ->
+            str
+
+        Err msg ->
+            "ERR:" ++ msg
+
+
+prompt : String
+prompt =
+    "user> "
+
+
+{-| read can return three things:
+
+Ok (Just expr) -> parsed okay
+Ok Nothing -> empty string (only whitespace and/or comments)
+Err msg -> parse error
+
+-}
+read : String -> Result String (Maybe MalExpr)
+read =
+    readString
+
+
+eval : MalExpr -> Eval MalExpr
+eval ast =
+    case ast of
+        MalList [] ->
+            Eval.succeed ast
+
+        MalList ((MalSymbol "def!") :: args) ->
+            evalDef args
+
+        MalList ((MalSymbol "let*") :: args) ->
+            evalLet args
+
+        MalList ((MalSymbol "do") :: args) ->
+            evalDo args
+
+        MalList ((MalSymbol "if") :: args) ->
+            evalIf args
+
+        MalList ((MalSymbol "fn*") :: args) ->
+            evalFn args
+
+        MalList list ->
+            evalList list
+                |> Eval.andThen
+                    (\newList ->
+                        case newList of
+                            [] ->
+                                Eval.fail "can't happen"
+
+                            (MalFunction fn) :: args ->
+                                fn args
+
+                            fn :: _ ->
+                                Eval.fail ((printString True fn) ++ " is not a function")
+                    )
+
+        _ ->
+            evalAst ast
+
+
+evalAst : MalExpr -> Eval MalExpr
+evalAst ast =
+    case ast of
+        MalSymbol sym ->
+            -- Lookup symbol in env and return value or raise error if not found.
+            Eval.withState
+                (\state ->
+                    case Env.get sym state.env of
+                        Ok val ->
+                            Eval.succeed val
+
+                        Err msg ->
+                            Eval.fail msg
+                )
+
+        MalList list ->
+            -- Return new list that is result of calling eval on each element of list.
+            evalList list
+                |> Eval.map MalList
+
+        MalVector vec ->
+            evalList (Array.toList vec)
+                |> Eval.map (Array.fromList >> MalVector)
+
+        MalMap map ->
+            evalList (Dict.values map)
+                |> Eval.map
+                    (zip (Dict.keys map)
+                        >> Dict.fromList
+                        >> MalMap
+                    )
+
+        _ ->
+            Eval.succeed ast
+
+
+evalList : List MalExpr -> Eval (List MalExpr)
+evalList list =
+    let
+        go list acc =
+            case list of
+                [] ->
+                    Eval.succeed (List.reverse acc)
+
+                x :: rest ->
+                    eval x
+                        |> Eval.andThen
+                            (\val ->
+                                go rest (val :: acc)
+                            )
+    in
+        go list []
+
+
+evalDef : List MalExpr -> Eval MalExpr
+evalDef args =
+    case args of
+        [ MalSymbol name, uneValue ] ->
+            eval uneValue
+                |> Eval.andThen
+                    (\value ->
+                        Eval.modifyState
+                            (\state ->
+                                { state | env = Env.set name value state.env }
+                            )
+                            |> Eval.andThen (\_ -> Eval.succeed value)
+                    )
+
+        _ ->
+            Eval.fail "def! expected two args: name and value"
+
+
+evalLet : List MalExpr -> Eval MalExpr
+evalLet args =
+    let
+        evalBinds binds =
+            case binds of
+                (MalSymbol name) :: expr :: rest ->
+                    eval expr
+                        |> Eval.andThen
+                            (\value ->
+                                Eval.modifyState (\state -> { state | env = Env.set name value state.env })
+                                    |> Eval.andThen
+                                        (\_ ->
+                                            if List.isEmpty rest then
+                                                Eval.succeed ()
+                                            else
+                                                evalBinds rest
+                                        )
+                            )
+
+                _ ->
+                    Eval.fail "let* expected an even number of binds (symbol expr ..)"
+
+        go binds body =
+            Eval.modifyState (\state -> { state | env = Env.make (Just state.env) })
+                |> Eval.andThen (\_ -> evalBinds binds)
+                |> Eval.andThen (\_ -> eval body)
+    in
+        case args of
+            [ MalList binds, body ] ->
+                go binds body
+
+            [ MalVector bindsVec, body ] ->
+                go (Array.toList bindsVec) body
+
+            _ ->
+                Eval.fail "let* expected two args: binds and a body"
+
+
+evalDo : List MalExpr -> Eval MalExpr
+evalDo args =
+    let
+        returnLast list =
+            case last list of
+                Just value ->
+                    Eval.succeed value
+
+                Nothing ->
+                    Eval.fail "do expected at least one arg"
+    in
+        evalList args
+            |> Eval.andThen returnLast
+
+
+evalIf : List MalExpr -> Eval MalExpr
+evalIf args =
+    let
+        isThruthy expr =
+            expr /= MalNil && expr /= (MalBool False)
+
+        go condition trueExpr falseExpr =
+            eval condition
+                |> Eval.map isThruthy
+                |> Eval.andThen
+                    (\cond ->
+                        eval
+                            (if cond then
+                                trueExpr
+                             else
+                                falseExpr
+                            )
+                    )
+    in
+        case args of
+            [ condition, trueExpr ] ->
+                go condition trueExpr MalNil
+
+            [ condition, trueExpr, falseExpr ] ->
+                go condition trueExpr falseExpr
+
+            _ ->
+                Eval.fail "if expected at least two args"
+
+
+evalFn : List MalExpr -> Eval MalExpr
+evalFn args =
+    let
+        extractSymbols list acc =
+            case list of
+                [] ->
+                    Ok (List.reverse acc)
+
+                (MalSymbol name) :: rest ->
+                    extractSymbols rest (name :: acc)
+
+                _ ->
+                    Err "all binds in fn* must be a symbol"
+
+        bindArgs env pairs =
+            case pairs of
+                [] ->
+                    env
+
+                ( bind, arg ) :: rest ->
+                    bindArgs (Env.set bind arg env) rest
+
+        makeEnv binds args env =
+            zip binds args
+                |> bindArgs (Env.make (Just env))
+    in
+        case args of
+            [ MalList bindsList, body ] ->
+                case extractSymbols bindsList [] of
+                    Ok binds ->
+                        let
+                            fn args =
+                                if List.length args /= List.length binds then
+                                    Eval.fail <|
+                                        "function expected "
+                                            ++ (toString (List.length binds))
+                                            ++ " arguments, got "
+                                            ++ (toString (List.length binds))
+                                else
+                                    -- TODO: push state and pop afterwards!
+                                    -- TODO or temporary change state?
+                                    Eval.withState
+                                        (\state ->
+                                            Eval.putState ({ state | env = makeEnv binds args state.env })
+                                                |> Eval.andThen (\_ -> eval body)
+                                                |> Eval.andThen (\res -> Eval.putState state |> Eval.map (\_ -> res))
+                                        )
+                        in
+                            Eval.succeed (MalFunction fn)
+
+                    -- TODO explicitly pass current env
+                    Err msg ->
+                        Eval.fail msg
+
+            _ ->
+                Eval.fail "fn* expected two args: binds list and body"
+
+
+print : MalExpr -> String
+print =
+    printString True
+
+
+{-| Read-Eval-Print.
+
+Doesn't actually run the Eval but returns the monad.
+
+-}
+rep : String -> Maybe (Eval MalExpr)
+rep input =
+    case readString input of
+        Ok Nothing ->
+            Nothing
+
+        Err msg ->
+            Just (Eval.fail msg)
+
+        Ok (Just ast) ->
+            eval ast |> Just