elm/Eval.elm

   1 module Eval exposing (..)
   2
   3 import Types exposing (..)
   4 import IO exposing (IO)
   5 import Env
   6 import Printer
   7
   8
   9 apply : Eval a -> Env -> EvalContext a
  10 apply (Eval f) state =
  11     f state
  12
  13
  14 run : Env -> Eval a -> EvalContext a
  15 run state e =
  16     apply e state
  17
  18
  19 withEnv : (Env -> Eval a) -> Eval a
  20 withEnv f =
  21     Eval <|
  22         \state ->
  23             apply (f state) state
  24
  25
  26 setEnv : Env -> Eval ()
  27 setEnv state =
  28     Eval <|
  29         \_ ->
  30             apply (succeed ()) state
  31
  32
  33 modifyEnv : (Env -> Env) -> Eval ()
  34 modifyEnv f =
  35     Eval <|
  36         \state ->
  37             apply (succeed ()) (f state)
  38
  39
  40 succeed : a -> Eval a
  41 succeed res =
  42     Eval <|
  43         \state ->
  44             ( state, EvalOk res )
  45
  46
  47 io : Cmd Msg -> (IO -> Eval a) -> Eval a
  48 io cmd cont =
  49     Eval <|
  50         \state ->
  51             ( state, EvalIO cmd cont )
  52
  53
  54 map : (a -> b) -> Eval a -> Eval b
  55 map f e =
  56     Eval <|
  57         \state ->
  58             case apply e state of
  59                 ( state, EvalOk res ) ->
  60                     ( state, EvalOk (f res) )
  61
  62                 ( state, EvalErr msg ) ->
  63                     ( state, EvalErr msg )
  64
  65                 ( state, EvalIO cmd cont ) ->
  66                     ( state, EvalIO cmd (cont >> map f) )
  67
  68
  69 andThen : (a -> Eval b) -> Eval a -> Eval b
  70 andThen f e =
  71     Eval <|
  72         \state ->
  73             case apply e state of
  74                 ( state, EvalOk res ) ->
  75                     apply (f res) state
  76
  77                 ( state, EvalErr msg ) ->
  78                     ( state, EvalErr msg )
  79
  80                 ( state, EvalIO cmd cont ) ->
  81                     ( state, EvalIO cmd (cont >> andThen f) )
  82
  83
  84 fail : String -> Eval a
  85 fail msg =
  86     Eval <|
  87         \state ->
  88             ( state, EvalErr msg )
  89
  90
  91 enter : Int -> List ( String, MalExpr ) -> Eval a -> Eval a
  92 enter frameId bound body =
  93     withEnv
  94         (\env ->
  95             modifyEnv (Env.enter frameId bound)
  96                 |> andThen (\_ -> body)
  97                 |> andThen
  98                     (\res ->
  99                         modifyEnv (Env.leave env.currentFrameId)
 100                             |> map (\_ -> res)
 101                     )
 102         )