kanaka/mal
1
1
Fork 0
mirror of https://github.com/kanaka/mal.git synced 2024-09-20 01:57:09 +03:00
Code Issues Projects Releases Wiki Activity

Elm: fix step 2 and 3

Browse Source
This commit is contained in:
Jos van Bakel 2017-06-25 10:59:09 +02:00
parent ac9c71d69e
commit 74547df6e4
3 changed files with 59 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
elm/Makefile
View File

@ -1,7 +1,6 @@
SOURCES = step0_repl.elm step1_read_print.elm \
step4_if_fn_do.elm step5_tco.elm step6_file.elm step7_quote.elm \
step8_macros.elm step9_try.elm stepA_mal.elm
#step2_eval.elm step3_env.elm
SOURCES = step0_repl.elm step1_read_print.elm step2_eval.elm \
step3_env.elm step4_if_fn_do.elm step5_tco.elm step6_file.elm \
step7_quote.elm step8_macros.elm step9_try.elm stepA_mal.elm
BINS = $(SOURCES:%.elm=%.js)
@ -24,9 +23,10 @@ STEP2_SOURCES = $(STEP1_SOURCES)
STEP3_SOURCES = $(STEP2_SOURCES)
STEP4_SOURCES = $(STEP3_SOURCES) Core.elm Eval.elm
step0_repl.js: $(STEP0_SOURCES)
step1_read_print.js: $(STEP1_SOURCES)
#step2_eval.js: Reader.elm Printer.elm Utils.elm Types.elm
#step3_env.js: Reader.elm Printer.elm Utils.elm Types.elm Env.elm
step2_eval.js: $(STEP2_SOURCES)
step3_env.js: $(STEP3_SOURCES)
step4_if_fn_do.js: $(STEP4_SOURCES)
step5_tco.js: $(STEP4_SOURCES)
step6_file.js: $(STEP4_SOURCES)

29
elm/step2_eval.elm
View File

@ -3,13 +3,15 @@ port module Main exposing (..)
import IO exposing (..)
import Json.Decode exposing (decodeValue)
import Platform exposing (programWithFlags)
import Types exposing (MalExpr(..), MalFunction(..))
import Types exposing (..)
import Reader exposing (readString)
import Printer exposing (printString)
import Utils exposing (maybeToList, zip)
import Dict exposing (Dict)
import Tuple exposing (mapFirst)
import Tuple exposing (mapFirst, second)
import Array
import Eval
import Env
main : Program Flags Model Msg
@ -55,10 +57,10 @@ initReplEnv =
binaryOp fn args =
case args of
[ MalInt x, MalInt y ] ->
Ok <| MalInt (fn x y)
Eval.succeed <| MalInt (fn x y)
_ ->
Err "unsupported arguments"
Eval.fail "unsupported arguments"
in
Dict.fromList
[ ( "+", makeFn <| binaryOp (+) )
@ -85,6 +87,9 @@ update msg model =
Input (Ok (LineRead Nothing)) ->
( model, Cmd.none )
Input (Ok io) ->
Debug.crash "unexpected IO received: " io
Input (Err msg) ->
Debug.crash msg ( model, Cmd.none )
@ -129,11 +134,19 @@ eval env ast =
[] ->
( Err "can't happen", newEnv )
(MalFunction fn) :: args ->
( fn args, newEnv )
(MalFunction (CoreFunc fn)) :: args ->
case second <| Eval.run Env.global (fn args) of
EvalOk res ->
( Ok res, newEnv )
EvalErr msg ->
( Err (print msg), newEnv )
_ ->
Debug.crash "can't happen"
fn :: _ ->
( Err ((printString True fn) ++ " is not a function"), newEnv )
( Err ((print fn) ++ " is not a function"), newEnv )
( Err msg, newEnv ) ->
( Err msg, newEnv )
@ -219,7 +232,7 @@ tryMapList fn list =
print : MalExpr -> String
print =
printString True
printString Env.global True
{-| Read-Eval-Print. rep returns:

48
elm/step3_env.elm
View File

@ -3,14 +3,15 @@ port module Main exposing (..)
import IO exposing (..)
import Json.Decode exposing (decodeValue)
import Platform exposing (programWithFlags)
import Types exposing (MalExpr(..))
import Types exposing (..)
import Reader exposing (readString)
import Printer exposing (printString)
import Utils exposing (maybeToList, zip)
import Dict exposing (Dict)
import Tuple exposing (mapFirst, mapSecond)
import Tuple exposing (mapFirst, mapSecond, second)
import Array
import Env exposing (Env)
import Env
import Eval
main : Program Flags Model Msg
@ -45,19 +46,22 @@ init { args } =
initReplEnv : Env
initReplEnv =
let
makeFn =
CoreFunc >> MalFunction
binaryOp fn args =
case args of
[ MalInt x, MalInt y ] ->
Ok <| MalInt (fn x y)
Eval.succeed <| MalInt (fn x y)
_ ->
Err "unsupported arguments"
Eval.fail "unsupported arguments"
in
Env.make Nothing
|> Env.set "+" (MalFunction <| binaryOp (+))
|> Env.set "-" (MalFunction <| binaryOp (-))
|> Env.set "*" (MalFunction <| binaryOp (*))
|> Env.set "/" (MalFunction <| binaryOp (//))
Env.global
|> Env.set "+" (makeFn <| binaryOp (+))
|> Env.set "-" (makeFn <| binaryOp (-))
|> Env.set "*" (makeFn <| binaryOp (*))
|> Env.set "/" (makeFn <| binaryOp (//))
update : Msg -> Model -> ( Model, Cmd Msg )
@ -77,6 +81,9 @@ update msg model =
Input (Ok (LineRead Nothing)) ->
( model, Cmd.none )
Input (Ok io) ->
Debug.crash "unexpected IO received: " io
Input (Err msg) ->
Debug.crash msg ( model, Cmd.none )
@ -127,11 +134,19 @@ eval env ast =
[] ->
( Err "can't happen", newEnv )
(MalFunction fn) :: args ->
( fn args, newEnv )
(MalFunction (CoreFunc fn)) :: args ->
case second <| Eval.run Env.global (fn args) of
EvalOk res ->
( Ok res, newEnv )
EvalErr msg ->
( Err (print msg), newEnv )
_ ->
Debug.crash "can't happen"
fn :: _ ->
( Err ((printString True fn) ++ " is not a function"), newEnv )
( Err ((print fn) ++ " is not a function"), newEnv )
( Err msg, newEnv ) ->
( Err msg, newEnv )
@ -229,9 +244,10 @@ evalLet env args =
Err "let* expected an even number of binds (symbol expr ..)"
go binds body =
case evalBinds (Env.make (Just env)) binds of
case evalBinds (Env.push env) binds of
Ok newEnv ->
mapSecond (\_ -> env) (eval newEnv body)
eval newEnv body
|> mapSecond (\_ -> Env.pop newEnv)
Err msg ->
( Err msg, env )
@ -274,7 +290,7 @@ tryMapList fn list =
print : MalExpr -> String
print =
printString True
printString Env.global True
{-| Read-Eval-Print. rep returns: