elm/step2_eval.elm

   1 port module Main exposing (..)
   2
   3 import IO exposing (..)
   4 import Json.Decode exposing (decodeValue)
   5 import Platform exposing (programWithFlags)
   6 import Types exposing (..)
   7 import Reader exposing (readString)
   8 import Printer exposing (printStr)
   9 import Utils exposing (maybeToList, zip)
  10 import Dict exposing (Dict)
  11 import Tuple exposing (mapFirst, second)
  12 import Array
  13 import Eval
  14
  15
  16 main : Program Flags Model Msg
  17 main =
  18     programWithFlags
  19         { init = init
  20         , update = update
  21         , subscriptions =
  22             \model -> input (decodeValue decodeIO >> Input)
  23         }
  24
  25
  26 type alias Flags =
  27     { args : List String
  28     }
  29
  30
  31 type alias ReplEnv =
  32     Dict String MalExpr
  33
  34
  35 type alias Model =
  36     { args : List String
  37     , env : ReplEnv
  38     }
  39
  40
  41 type Msg
  42     = Input (Result String IO)
  43
  44
  45 init : Flags -> ( Model, Cmd Msg )
  46 init { args } =
  47     ( { args = args, env = initReplEnv }, readLine prompt )
  48
  49
  50 initReplEnv : ReplEnv
  51 initReplEnv =
  52     let
  53         makeFn =
  54             CoreFunc >> MalFunction
  55
  56         binaryOp fn args =
  57             case args of
  58                 [ MalInt x, MalInt y ] ->
  59                     Eval.succeed <| MalInt (fn x y)
  60
  61                 _ ->
  62                     Eval.fail "unsupported arguments"
  63     in
  64         Dict.fromList
  65             [ ( "+", makeFn <| binaryOp (+) )
  66             , ( "-", makeFn <| binaryOp (-) )
  67             , ( "*", makeFn <| binaryOp (*) )
  68             , ( "/", makeFn <| binaryOp (//) )
  69             ]
  70
  71
  72 update : Msg -> Model -> ( Model, Cmd Msg )
  73 update msg model =
  74     case msg of
  75         Input (Ok (LineRead (Just line))) ->
  76             case rep model.env line of
  77                 Nothing ->
  78                     ( model, readLine prompt )
  79
  80                 Just ( result, newEnv ) ->
  81                     ( { model | env = newEnv }, writeLine (makeOutput result) )
  82
  83         Input (Ok LineWritten) ->
  84             ( model, readLine prompt )
  85
  86         Input (Ok (LineRead Nothing)) ->
  87             ( model, Cmd.none )
  88
  89         Input (Ok io) ->
  90             Debug.crash "unexpected IO received: " io
  91
  92         Input (Err msg) ->
  93             Debug.crash msg ( model, Cmd.none )
  94
  95
  96 makeOutput : Result String String -> String
  97 makeOutput result =
  98     case result of
  99         Ok str ->
 100             str
 101
 102         Err msg ->
 103             "Error: " ++ msg
 104
 105
 106 prompt : String
 107 prompt =
 108     "user> "
 109
 110
 111 {-| read can return three things:
 112
 113 Ok (Just expr) -> parsed okay
 114 Ok Nothing -> empty string (only whitespace and/or comments)
 115 Err msg -> parse error
 116
 117 -}
 118 read : String -> Result String (Maybe MalExpr)
 119 read =
 120     readString
 121
 122
 123 eval : ReplEnv -> MalExpr -> ( Result String MalExpr, ReplEnv )
 124 eval env ast =
 125     case ast of
 126         MalList [] ->
 127             ( Ok ast, env )
 128
 129         MalList list ->
 130             case evalList env list [] of
 131                 ( Ok newList, newEnv ) ->
 132                     case newList of
 133                         [] ->
 134                             ( Err "can't happen", newEnv )
 135
 136                         (MalFunction (CoreFunc fn)) :: args ->
 137                             case Eval.runSimple (fn args) of
 138                                 Ok res ->
 139                                     ( Ok res, newEnv )
 140
 141                                 Err msg ->
 142                                     ( Err (print msg), newEnv )
 143
 144                         fn :: _ ->
 145                             ( Err ((print fn) ++ " is not a function"), newEnv )
 146
 147                 ( Err msg, newEnv ) ->
 148                     ( Err msg, newEnv )
 149
 150         _ ->
 151             evalAst env ast
 152
 153
 154 evalAst : ReplEnv -> MalExpr -> ( Result String MalExpr, ReplEnv )
 155 evalAst env ast =
 156     case ast of
 157         MalSymbol sym ->
 158             -- Lookup symbol in env and return value or raise error if not found.
 159             case Dict.get sym env of
 160                 Just val ->
 161                     ( Ok val, env )
 162
 163                 Nothing ->
 164                     ( Err "symbol not found", env )
 165
 166         MalList list ->
 167             -- Return new list that is result of calling eval on each element of list.
 168             evalList env list []
 169                 |> mapFirst (Result.map MalList)
 170
 171         MalVector vec ->
 172             evalList env (Array.toList vec) []
 173                 |> mapFirst (Result.map (Array.fromList >> MalVector))
 174
 175         MalMap map ->
 176             evalList env (Dict.values map) []
 177                 |> mapFirst
 178                     (Result.map
 179                         (zip (Dict.keys map)
 180                             >> Dict.fromList
 181                             >> MalMap
 182                         )
 183                     )
 184
 185         _ ->
 186             ( Ok ast, env )
 187
 188
 189 evalList : ReplEnv -> List MalExpr -> List MalExpr -> ( Result String (List MalExpr), ReplEnv )
 190 evalList env list acc =
 191     case list of
 192         [] ->
 193             ( Ok (List.reverse acc), env )
 194
 195         x :: rest ->
 196             case eval env x of
 197                 ( Ok val, newEnv ) ->
 198                     evalList newEnv rest (val :: acc)
 199
 200                 ( Err msg, newEnv ) ->
 201                     ( Err msg, newEnv )
 202
 203
 204 {-| Try to map a list with a fn that can return a Err.
 205
 206 Maps the list from left to right. As soon as a error
 207 occurs it will not process any more elements and return
 208 the error.
 209
 210 -}
 211 tryMapList : (a -> Result e b) -> List a -> Result e (List b)
 212 tryMapList fn list =
 213     let
 214         go x =
 215             Result.andThen
 216                 (\acc ->
 217                     case fn x of
 218                         Ok val ->
 219                             Ok (val :: acc)
 220
 221                         Err msg ->
 222                             Err msg
 223                 )
 224     in
 225         List.foldl go (Ok []) list
 226             |> Result.map List.reverse
 227
 228
 229 print : MalExpr -> String
 230 print =
 231     printStr True
 232
 233
 234 {-| Read-Eval-Print. rep returns:
 235
 236 Nothing -> if an empty string is read (ws/comments)
 237 Just ((Ok out), newEnv) -> input has been evaluated.
 238 Just ((Err msg), env) -> error parsing or evaluating.
 239
 240 -}
 241 rep : ReplEnv -> String -> Maybe ( Result String String, ReplEnv )
 242 rep env input =
 243     let
 244         evalPrint =
 245             eval env >> mapFirst (Result.map print)
 246     in
 247         case readString input of
 248             Ok Nothing ->
 249                 Nothing
 250
 251             Err msg ->
 252                 Just ( Err msg, env )
 253
 254             Ok (Just ast) ->
 255                 Just (evalPrint ast)