elm/Env.elm

   1 module Env
   2     exposing
   3         ( debug
   4         , global
   5         , push
   6         , pop
   7         , enter
   8         , leave
   9         , ref
  10         , get
  11         , set
  12         , newAtom
  13         , getAtom
  14         , setAtom
  15         , gc
  16         )
  17
  18 import Types exposing (MalExpr(..), MalFunction(..), Frame, Env)
  19 import Dict
  20 import Array
  21 import Set
  22
  23
  24 debug : Env -> String -> a -> a
  25 debug env msg value =
  26     if env.debug then
  27         Debug.log msg value
  28     else
  29         value
  30
  31
  32 globalFrameId : Int
  33 globalFrameId =
  34     0
  35
  36
  37 global : Env
  38 global =
  39     { frames = Dict.singleton globalFrameId (emptyFrame Nothing)
  40     , nextFrameId = globalFrameId + 1
  41     , currentFrameId = globalFrameId
  42     , atoms = Dict.empty
  43     , nextAtomId = 0
  44     , debug = True
  45     }
  46
  47
  48 push : Env -> Env
  49 push env =
  50     let
  51         frameId =
  52             env.nextFrameId
  53
  54         newFrame =
  55             emptyFrame (Just env.currentFrameId)
  56     in
  57         { env
  58             | currentFrameId = frameId
  59             , frames = Dict.insert frameId newFrame env.frames
  60             , nextFrameId = env.nextFrameId + 1
  61         }
  62
  63
  64 pop : Env -> Env
  65 pop env =
  66     let
  67         frameId =
  68             env.currentFrameId
  69     in
  70         case Dict.get frameId env.frames of
  71             Just currentFrame ->
  72                 case currentFrame.outerId of
  73                     Just outerId ->
  74                         { env
  75                             | currentFrameId = outerId
  76                             , frames = Dict.update frameId deref env.frames
  77                         }
  78
  79                     _ ->
  80                         Debug.crash "tried to pop global frame"
  81
  82             Nothing ->
  83                 Debug.crash <|
  84                     "current frame "
  85                         ++ (toString frameId)
  86                         ++ " doesn't exist"
  87
  88
  89 setBinds : List ( String, MalExpr ) -> Frame -> Frame
  90 setBinds binds frame =
  91     case binds of
  92         [] ->
  93             frame
  94
  95         ( name, expr ) :: rest ->
  96             setBinds rest
  97                 { frame | data = Dict.insert name expr frame.data }
  98
  99
 100 enter : Int -> List ( String, MalExpr ) -> Env -> Env
 101 enter parentFrameId binds env =
 102     let
 103         frameId =
 104             debug env "enter #" env.nextFrameId
 105
 106         newFrame =
 107             setBinds binds (emptyFrame (Just parentFrameId))
 108     in
 109         { env
 110             | currentFrameId = frameId
 111             , frames = Dict.insert frameId newFrame env.frames
 112             , nextFrameId = env.nextFrameId + 1
 113         }
 114
 115
 116 leave : Int -> Env -> Env
 117 leave orgFrameId env =
 118     let
 119         frameId =
 120             debug env "leave #" env.currentFrameId
 121     in
 122         { env
 123             | currentFrameId = orgFrameId
 124             , frames = Dict.update frameId deref env.frames
 125         }
 126
 127
 128 {-| Increase refCnt for the current frame
 129 -}
 130 ref : Env -> Env
 131 ref env =
 132     let
 133         incRef =
 134             Maybe.map
 135                 (\frame ->
 136                     { frame | refCnt = frame.refCnt + 1 }
 137                 )
 138
 139         newFrames =
 140             Dict.update env.currentFrameId incRef env.frames
 141     in
 142         { env | frames = newFrames }
 143
 144
 145 deref : Maybe Frame -> Maybe Frame
 146 deref =
 147     Maybe.andThen
 148         (\frame ->
 149             if frame.refCnt == 1 then
 150                 Nothing
 151             else
 152                 Just { frame | refCnt = frame.refCnt - 1 }
 153         )
 154
 155
 156 {-| Given an Env see which frames are not reachable from the
 157 global frame. Return a new Env without the unreachable frames.
 158 -}
 159 gc : Env -> Env
 160 gc env =
 161     let
 162         countList acc =
 163             List.foldl countRefs acc
 164
 165         countFrame acc { data } =
 166             data |> Dict.values |> countList acc
 167
 168         countRefs expr acc =
 169             debug env ("gc-visit " ++ (toString expr)) <|
 170                 case expr of
 171                     MalFunction (UserFunc { frameId }) ->
 172                         if not (Set.member frameId acc) then
 173                             debug env "gc-counting" <|
 174                                 case Dict.get frameId env.frames of
 175                                     Just frame ->
 176                                         countFrame (Set.insert frameId acc) frame
 177
 178                                     Nothing ->
 179                                         Debug.crash ("frame " ++ (toString frameId) ++ " not found in GC")
 180                         else
 181                             acc
 182
 183                     MalList list ->
 184                         countList acc list
 185
 186                     MalVector vec ->
 187                         countList acc (Array.toList vec)
 188
 189                     MalMap map ->
 190                         countList acc (Dict.values map)
 191
 192                     _ ->
 193                         acc
 194
 195         initSet =
 196             Set.fromList [ globalFrameId, env.currentFrameId ]
 197
 198         reportUnused frames used =
 199             Dict.diff frames used
 200                 |> debug env "unused frames"
 201                 |> (\_ -> frames)
 202     in
 203         case Dict.get globalFrameId env.frames of
 204             Nothing ->
 205                 Debug.crash "global frame not found"
 206
 207             Just globalFrame ->
 208                 countFrame initSet globalFrame
 209                     |> Set.toList
 210                     |> debug env "used frames"
 211                     |> List.map (\frameId -> ( frameId, emptyFrame Nothing ))
 212                     |> Dict.fromList
 213                     |> reportUnused env.frames
 214                     |> Dict.intersect env.frames
 215                     |> (\frames -> { env | frames = frames })
 216
 217
 218 emptyFrame : Maybe Int -> Frame
 219 emptyFrame outerId =
 220     { outerId = outerId
 221     , data = Dict.empty
 222     , refCnt = 1
 223     }
 224
 225
 226 set : String -> MalExpr -> Env -> Env
 227 set name expr env =
 228     let
 229         updateFrame =
 230             Maybe.map
 231                 (\frame ->
 232                     { frame | data = Dict.insert name expr frame.data }
 233                 )
 234
 235         frameId =
 236             env.currentFrameId
 237
 238         newFrames =
 239             Dict.update frameId updateFrame env.frames
 240     in
 241         { env | frames = newFrames }
 242
 243
 244 get : String -> Env -> Result String MalExpr
 245 get name env =
 246     let
 247         go frameId =
 248             case Dict.get frameId env.frames of
 249                 Nothing ->
 250                     Err <| "frame " ++ (toString frameId) ++ " not found"
 251
 252                 Just frame ->
 253                     case Dict.get name frame.data of
 254                         Just value ->
 255                             Ok value
 256
 257                         Nothing ->
 258                             frame.outerId
 259                                 |> Maybe.map go
 260                                 |> Maybe.withDefault (Err "symbol not found")
 261     in
 262         go env.currentFrameId
 263
 264
 265 newAtom : MalExpr -> Env -> ( Env, Int )
 266 newAtom value env =
 267     let
 268         atomId =
 269             env.nextAtomId
 270
 271         newEnv =
 272             { env
 273                 | atoms = Dict.insert atomId value env.atoms
 274                 , nextAtomId = atomId + 1
 275             }
 276     in
 277         ( newEnv, atomId )
 278
 279
 280 getAtom : Int -> Env -> MalExpr
 281 getAtom atomId env =
 282     case Dict.get atomId env.atoms of
 283         Just value ->
 284             value
 285
 286         Nothing ->
 287             Debug.crash <| "atom " ++ (toString atomId) ++ " not found"
 288
 289
 290 setAtom : Int -> MalExpr -> Env -> Env
 291 setAtom atomId value env =
 292     { env
 293         | atoms = Dict.insert atomId value env.atoms
 294     }