kanaka/mal
1
1
Fork 0
mirror of https://github.com/kanaka/mal.git synced 2024-09-20 10:07:45 +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 \ SOURCES = step0_repl.elm step1_read_print.elm step2_eval.elm \
step4_if_fn_do.elm step5_tco.elm step6_file.elm step7_quote.elm \ step3_env.elm step4_if_fn_do.elm step5_tco.elm step6_file.elm \
step8_macros.elm step9_try.elm stepA_mal.elm step7_quote.elm step8_macros.elm step9_try.elm stepA_mal.elm
#step2_eval.elm step3_env.elm
BINS = $(SOURCES:%.elm=%.js) BINS = $(SOURCES:%.elm=%.js)
@ -24,9 +23,10 @@ STEP2_SOURCES = $(STEP1_SOURCES)
STEP3_SOURCES = $(STEP2_SOURCES) STEP3_SOURCES = $(STEP2_SOURCES)
STEP4_SOURCES = $(STEP3_SOURCES) Core.elm Eval.elm STEP4_SOURCES = $(STEP3_SOURCES) Core.elm Eval.elm
step0_repl.js: $(STEP0_SOURCES)
step1_read_print.js: $(STEP1_SOURCES) step1_read_print.js: $(STEP1_SOURCES)
#step2_eval.js: Reader.elm Printer.elm Utils.elm Types.elm step2_eval.js: $(STEP2_SOURCES)
#step3_env.js: Reader.elm Printer.elm Utils.elm Types.elm Env.elm step3_env.js: $(STEP3_SOURCES)
step4_if_fn_do.js: $(STEP4_SOURCES) step4_if_fn_do.js: $(STEP4_SOURCES)
step5_tco.js: $(STEP4_SOURCES) step5_tco.js: $(STEP4_SOURCES)
step6_file.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 IO exposing (..)
import Json.Decode exposing (decodeValue) import Json.Decode exposing (decodeValue)
import Platform exposing (programWithFlags) import Platform exposing (programWithFlags)
import Types exposing (MalExpr(..), MalFunction(..)) import Types exposing (..)
import Reader exposing (readString) import Reader exposing (readString)
import Printer exposing (printString) import Printer exposing (printString)
import Utils exposing (maybeToList, zip) import Utils exposing (maybeToList, zip)
import Dict exposing (Dict) import Dict exposing (Dict)
import Tuple exposing (mapFirst) import Tuple exposing (mapFirst, second)
import Array import Array
import Eval
import Env
main : Program Flags Model Msg main : Program Flags Model Msg
@ -55,10 +57,10 @@ initReplEnv =
binaryOp fn args = binaryOp fn args =
case args of case args of
[ MalInt x, MalInt y ] -> [ MalInt x, MalInt y ] ->
Ok <| MalInt (fn x y) Eval.succeed <| MalInt (fn x y)
_ -> _ ->
Err "unsupported arguments" Eval.fail "unsupported arguments"
in in
Dict.fromList Dict.fromList
[ ( "+", makeFn <| binaryOp (+) ) [ ( "+", makeFn <| binaryOp (+) )
@ -85,6 +87,9 @@ update msg model =
Input (Ok (LineRead Nothing)) -> Input (Ok (LineRead Nothing)) ->
( model, Cmd.none ) ( model, Cmd.none )
Input (Ok io) ->
Debug.crash "unexpected IO received: " io
Input (Err msg) -> Input (Err msg) ->
Debug.crash msg ( model, Cmd.none ) Debug.crash msg ( model, Cmd.none )
@ -129,11 +134,19 @@ eval env ast =
[] -> [] ->
( Err "can't happen", newEnv ) ( Err "can't happen", newEnv )
(MalFunction fn) :: args -> (MalFunction (CoreFunc fn)) :: args ->
( fn args, newEnv ) 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 :: _ -> fn :: _ ->
( Err ((printString True fn) ++ " is not a function"), newEnv ) ( Err ((print fn) ++ " is not a function"), newEnv )
( Err msg, newEnv ) -> ( Err msg, newEnv ) ->
( Err msg, newEnv ) ( Err msg, newEnv )
@ -219,7 +232,7 @@ tryMapList fn list =
print : MalExpr -> String print : MalExpr -> String
print = print =
printString True printString Env.global True
{-| Read-Eval-Print. rep returns: {-| Read-Eval-Print. rep returns:

48
elm/step3_env.elm
View File

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