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: GC almost working.

Browse Source
This commit is contained in:
Jos van Bakel 2017-07-18 21:34:36 +02:00
parent 43d8bb4e2e
commit 4c696bfb54
14 changed files with 241 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
elm/Core.elm
View File

@ -500,12 +500,12 @@ ns =
callFn func [ inv ]
|> Eval.andThen
(\outv ->
go func rest (outv :: acc)
Eval.pushRef outv (go func rest (outv :: acc))
)
in
case args of
[ MalFunction func, MalList list ] ->
go func list []
Eval.withStack (go func list [])
[ MalFunction func, MalVector vec ] ->
go func (Array.toList vec) []

194
elm/Env.elm
View File

@ -3,17 +3,19 @@ module Env
( debug
, globalFrameId
, global
, push
, pop
, jump
, enter
, leave
, ref
, get
, set
, newAtom
, getAtom
, setAtom
, push
, pop
, enter
, jump
, leave
, ref
, pushRef
, restoreRefs
, gc
)
@ -38,12 +40,12 @@ globalFrameId =
defaultGcInterval : Int
defaultGcInterval =
3
10
global : Env
global =
{ frames = Dict.singleton globalFrameId (emptyFrame Nothing)
{ frames = Dict.singleton globalFrameId (emptyFrame Nothing Nothing)
, nextFrameId = globalFrameId + 1
, currentFrameId = globalFrameId
, atoms = Dict.empty
@ -51,11 +53,12 @@ global =
, debug = False
, gcInterval = defaultGcInterval
, gcCounter = 0
, stack = []
}
getFrame : Int -> Env -> Frame
getFrame frameId env =
getFrame : Env -> Int -> Frame
getFrame env frameId =
case Dict.get frameId env.frames of
Just frame ->
frame
@ -64,9 +67,10 @@ getFrame frameId env =
Debug.crash <| "frame #" ++ (toString frameId) ++ " not found"
emptyFrame : Maybe Int -> Frame
emptyFrame outerId =
emptyFrame : Maybe Int -> Maybe Int -> Frame
emptyFrame outerId exitId =
{ outerId = outerId
, exitId = exitId
, data = Dict.empty
, refCnt = 1
}
@ -96,7 +100,7 @@ get name env =
go frameId =
let
frame =
getFrame frameId env
getFrame env frameId
in
case Dict.get name frame.data of
Just value ->
@ -142,11 +146,6 @@ setAtom atomId value env =
}
jump : Int -> Env -> Env
jump frameId env =
{ env | currentFrameId = frameId }
push : Env -> Env
push env =
let
@ -154,7 +153,10 @@ push env =
env.nextFrameId
newFrame =
emptyFrame (Just env.currentFrameId)
emptyFrame (Just env.currentFrameId) Nothing
bogus =
debug env "push" frameId
in
{ env
| currentFrameId = frameId
@ -170,7 +172,10 @@ pop env =
env.currentFrameId
frame =
getFrame frameId env
getFrame env frameId
bogus =
debug env "pop" frameId
in
case frame.outerId of
Just outerId ->
@ -194,14 +199,19 @@ setBinds binds frame =
{ frame | data = Dict.insert name expr frame.data }
{-| Enter a new frame with a set of binds
-}
enter : Int -> List ( String, MalExpr ) -> Env -> Env
enter parentFrameId binds env =
enter outerId binds env =
let
frameId =
debug env "enter #" env.nextFrameId
exitId =
env.currentFrameId
newFrame =
setBinds binds (emptyFrame (Just parentFrameId))
setBinds binds (emptyFrame (Just outerId) (Just exitId))
in
{ env
| currentFrameId = frameId
@ -210,15 +220,55 @@ enter parentFrameId binds env =
}
leave : Int -> Env -> Env
leave orgFrameId env =
{-| Jump into a frame
-}
jump : Int -> Env -> Env
jump frameId env =
let
setExitId =
Maybe.map
(\frame ->
{ frame
| exitId = Just env.currentFrameId
, refCnt = frame.refCnt + 1
}
)
bogus =
debug env "jump #" frameId
in
{ env
| currentFrameId = frameId
, frames = Dict.update frameId setExitId env.frames
}
leave : Env -> Env
leave env =
let
frameId =
debug env "leave #" env.currentFrameId
frame =
getFrame env frameId
exitId =
case frame.exitId of
Just exitId ->
exitId
Nothing ->
Debug.crash <|
"frame #"
++ (toString frameId)
++ " doesn't have an exitId"
in
{ env
| currentFrameId = orgFrameId
, frames = Dict.update frameId free env.frames
| currentFrameId = exitId
, frames =
env.frames
|> Dict.insert frameId { frame | exitId = Nothing }
|> Dict.update frameId free
}
@ -231,7 +281,7 @@ ref env =
go frameId env =
let
frame =
getFrame frameId env
getFrame env frameId
newFrame =
{ frame | refCnt = frame.refCnt + 1 }
@ -263,6 +313,16 @@ free =
)
pushRef : MalExpr -> Env -> Env
pushRef ref env =
{ env | stack = ref :: env.stack }
restoreRefs : List MalExpr -> Env -> Env
restoreRefs refs env =
{ env | stack = refs }
{-| Given an Env see which frames are not reachable from the
global frame, or from the current expression.
@ -270,10 +330,12 @@ Return a new Env with the unreachable frames removed.
-}
gc : MalExpr -> Env -> Env
gc currentExpr env =
gc expr env =
let
-- bogus =
-- Debug.log "GC stack = " env.stack
countList acc =
List.foldl countRefs acc
List.foldl countExpr acc
countFrame { data } acc =
data |> Dict.values |> countList acc
@ -282,22 +344,28 @@ gc currentExpr env =
if not (Set.member frameId acc) then
let
frame =
getFrame frameId env
getFrame env frameId
newAcc =
(Set.insert frameId acc)
Set.insert frameId acc
in
countFrame frame newAcc
else
acc
countRefs expr acc =
countBound bound acc =
bound
|> List.map Tuple.second
|> countList acc
countExpr expr acc =
case expr of
MalFunction (UserFunc { frameId }) ->
recur frameId acc
MalApply { frameId } ->
MalApply { frameId, bound } ->
recur frameId acc
|> countBound bound
MalList list ->
countList acc list
@ -313,7 +381,7 @@ gc currentExpr env =
value =
getAtom atomId env
in
countRefs value acc
countExpr value acc
_ ->
acc
@ -321,26 +389,42 @@ gc currentExpr env =
initSet =
Set.fromList [ globalFrameId, env.currentFrameId ]
expandParents frameId acc =
countFrames frames acc =
Set.toList frames
|> List.map (getFrame env)
|> List.foldl countFrame acc
expand frameId frame fn acc =
case fn frame of
Nothing ->
acc
Just parentId ->
Set.insert parentId acc
expandBoth frameId =
let
frame =
getFrame frameId env
getFrame env frameId
in
case frame.outerId of
Just parentId ->
Set.insert parentId acc
expand frameId frame .outerId
>> expand frameId frame .exitId
Nothing ->
acc
expandParents frames =
Set.foldl expandBoth frames frames
expandAllFrames frames =
Set.foldl expandParents frames frames
loop acc =
let
newAcc =
expandParents acc
makeEmptyFrame frameId =
( frameId, emptyFrame Nothing )
globalFrame =
getFrame globalFrameId env
newParents =
Set.diff newAcc acc
in
if Set.isEmpty newParents then
newAcc
else
loop <| countFrames newParents newAcc
makeNewEnv newFrames =
{ env
@ -353,10 +437,16 @@ gc currentExpr env =
filterFrames frames keep =
Dict.filter (keepFilter keep) frames
reportUnused frames keep =
Set.diff (Set.fromList (Dict.keys frames)) keep
|> Debug.log "\n\nUNUSED FRAMES\n\n"
|> always keep
in
initSet
|> countRefs currentExpr
|> countFrame globalFrame
|> expandAllFrames
countFrames initSet initSet
|> countExpr expr
|> (flip countList) env.stack
|> loop
-- |> reportUnused env.frames
|> filterFrames env.frames
|> makeNewEnv

25
elm/Eval.elm
View File

@ -3,6 +3,7 @@ module Eval exposing (..)
import Types exposing (..)
import IO exposing (IO)
import Env
import Printer exposing (printEnv)
apply : Eval a -> Env -> EvalContext a
@ -89,6 +90,12 @@ gcPass e env =
let
go env t expr =
if env.gcCounter >= env.gcInterval then
--Debug.log
-- ("before GC: "
-- ++ (printEnv env)
-- )
-- ""
-- |> always ( Env.gc env, t expr )
( Env.gc expr env, t expr )
else
( env, t expr )
@ -172,3 +179,21 @@ ignore right left =
right
|> andThen (\_ -> succeed res)
)
withStack : Eval a -> Eval a
withStack e =
withEnv
(\env ->
e
|> ignore
(modifyEnv
(Env.restoreRefs env.stack)
)
)
pushRef : MalExpr -> Eval a -> Eval a
pushRef ref e =
modifyEnv (Env.pushRef ref)
|> andThen (always e)

2
elm/Makefile
View File

@ -1,4 +1,4 @@
SOURCES = step0_repl.elm step1_read_print.elm step2_eval.elm \
SOURCES = stepA_mal.elm #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

35
elm/Printer.elm
View File

@ -2,7 +2,7 @@ module Printer exposing (..)
import Array exposing (Array)
import Dict exposing (Dict)
import Types exposing (Env, MalExpr(..), keywordPrefix)
import Types exposing (Env, MalExpr(..), keywordPrefix, MalFunction(..))
import Utils exposing (encodeString, wrap)
import Env
@ -40,6 +40,18 @@ printString env readably ast =
MalMap map ->
printMap env readably map
MalFunction (UserFunc { frameId, meta }) ->
"#<function "
++ (toString frameId)
++ (case meta of
Nothing ->
""
Just meta ->
" meta=" ++ printString env True meta
)
++ ">"
MalFunction _ ->
"#<function>"
@ -50,8 +62,19 @@ printString env readably ast =
in
"(atom " ++ (printString env True value) ++ ")"
MalApply _ ->
"#<apply>"
MalApply { frameId, bound } ->
"#<apply " ++ (toString frameId) ++ " bound=" ++ (printBound env True bound) ++ ">"
printBound : Env -> Bool -> List ( String, MalExpr ) -> String
printBound env readably =
let
printEntry name value =
name ++ "=" ++ (printString env readably value)
in
List.map (uncurry printEntry)
>> String.join " "
>> wrap "(" ")"
printRawString : Env -> Bool -> String -> String
@ -107,11 +130,13 @@ printEnv env =
printOuterId =
Maybe.map toString >> Maybe.withDefault "nil"
printHeader frameId { outerId, refCnt } =
printHeader frameId { outerId, exitId, refCnt } =
"#"
++ (toString frameId)
++ " outer="
++ printOuterId outerId
++ " exit="
++ printOuterId exitId
++ " refCnt="
++ (toString refCnt)
@ -125,7 +150,7 @@ printEnv env =
printFrame k v :: acc
printDatum k v acc =
(k ++ " = " ++ (printString env True v)) :: acc
(k ++ " = " ++ (printString env False v)) :: acc
in
"--- Environment ---\n"
++ "Current frame: #"

2
elm/Types.elm
View File

@ -16,6 +16,7 @@ type Msg
type alias Frame =
{ outerId : Maybe Int
, exitId : Maybe Int
, data : Dict String MalExpr
, refCnt : Int
}
@ -30,6 +31,7 @@ type alias Env =
, debug : Bool
, gcInterval : Int
, gcCounter : Int
, stack : List MalExpr
}

6
elm/step4_if_fn_do.elm
View File

@ -187,7 +187,7 @@ eval ast =
fn args
(MalFunction (UserFunc { eagerFn })) :: args ->
eagerFn args
eagerFn [] args
fn :: _ ->
Eval.withEnv
@ -427,7 +427,7 @@ evalFn args =
(\env ->
Eval.modifyEnv (Env.enter frameId bound)
|> Eval.andThen (always (eval body))
|> Eval.finally (Env.leave env.currentFrameId)
|> Eval.finally Env.leave
)
Err msg ->
@ -437,7 +437,7 @@ evalFn args =
UserFunc
{ frameId = frameId
, lazyFn = fn
, eagerFn = fn
, eagerFn = always fn
, isMacro = False
, meta = Nothing
}

6
elm/step5_tco.elm
View File

@ -188,8 +188,8 @@ evalApply { frameId, bound, body } =
(\env ->
Eval.modifyEnv (Env.enter frameId bound)
|> Eval.andThen (\_ -> evalNoApply body)
|> Eval.finally (Env.leave env.currentFrameId)
|> Eval.gcPass
|> Eval.finally Env.leave
|> Eval.gcPass []
)
@ -475,7 +475,7 @@ evalFn args =
UserFunc
{ frameId = frameId
, lazyFn = lazyFn
, eagerFn = lazyFn >> Eval.andThen eval
, eagerFn = \_ -> lazyFn >> Eval.andThen eval
, isMacro = False
, meta = Nothing
}

8
elm/step6_file.elm
View File

@ -250,7 +250,7 @@ malEval args =
(\env ->
Eval.modifyEnv (Env.jump Env.globalFrameId)
|> Eval.andThen (\_ -> eval expr)
|> Eval.finally (Env.jump env.currentFrameId)
|> Eval.finally Env.leave
)
_ ->
@ -263,8 +263,8 @@ evalApply { frameId, bound, body } =
(\env ->
Eval.modifyEnv (Env.enter frameId bound)
|> Eval.andThen (\_ -> evalNoApply body)
|> Eval.finally (Env.leave env.currentFrameId)
|> Eval.gcPass
|> Eval.finally Env.leave
|> Eval.gcPass []
)
@ -550,7 +550,7 @@ evalFn args =
UserFunc
{ frameId = frameId
, lazyFn = lazyFn
, eagerFn = lazyFn >> Eval.andThen eval
, eagerFn = \_ -> lazyFn >> Eval.andThen eval
, isMacro = False
, meta = Nothing
}

8
elm/step7_quote.elm
View File

@ -250,7 +250,7 @@ malEval args =
(\env ->
Eval.modifyEnv (Env.jump Env.globalFrameId)
|> Eval.andThen (\_ -> eval expr)
|> Eval.finally (Env.jump env.currentFrameId)
|> Eval.finally Env.leave
)
_ ->
@ -263,8 +263,8 @@ evalApply { frameId, bound, body } =
(\env ->
Eval.modifyEnv (Env.enter frameId bound)
|> Eval.andThen (\_ -> evalNoApply body)
|> Eval.finally (Env.leave env.currentFrameId)
|> Eval.gcPass
|> Eval.finally Env.leave
|> Eval.gcPass []
)
@ -549,7 +549,7 @@ evalFn args =
UserFunc
{ frameId = frameId
, lazyFn = lazyFn
, eagerFn = lazyFn >> Eval.andThen eval
, eagerFn = \_ -> lazyFn >> Eval.andThen eval
, isMacro = False
, meta = Nothing
}

10
elm/step8_macros.elm
View File

@ -266,7 +266,7 @@ malEval args =
(\env ->
Eval.modifyEnv (Env.jump Env.globalFrameId)
|> Eval.andThen (\_ -> eval expr)
|> Eval.finally (Env.jump env.currentFrameId)
|> Eval.finally Env.leave
)
_ ->
@ -279,8 +279,8 @@ evalApply { frameId, bound, body } =
(\env ->
Eval.modifyEnv (Env.enter frameId bound)
|> Eval.andThen (\_ -> evalNoApply body)
|> Eval.finally (Env.leave env.currentFrameId)
|> Eval.gcPass
|> Eval.finally Env.leave
|> Eval.gcPass []
)
@ -604,7 +604,7 @@ evalFn args =
UserFunc
{ frameId = frameId
, lazyFn = lazyFn
, eagerFn = lazyFn >> Eval.andThen eval
, eagerFn = \_ -> lazyFn >> Eval.andThen eval
, isMacro = False
, meta = Nothing
}
@ -687,7 +687,7 @@ macroexpand expr =
case Env.get name env of
Ok (MalFunction (UserFunc fn)) ->
if fn.isMacro then
Left <| fn.eagerFn args
Left <| fn.eagerFn [] args
else
Right expr

10
elm/step9_try.elm
View File

@ -266,7 +266,7 @@ malEval args =
(\env ->
Eval.modifyEnv (Env.jump Env.globalFrameId)
|> Eval.andThen (\_ -> eval expr)
|> Eval.finally (Env.jump env.currentFrameId)
|> Eval.finally Env.leave
)
_ ->
@ -279,8 +279,8 @@ evalApply { frameId, bound, body } =
(\env ->
Eval.modifyEnv (Env.enter frameId bound)
|> Eval.andThen (\_ -> evalNoApply body)
|> Eval.finally (Env.leave env.currentFrameId)
|> Eval.gcPass
|> Eval.finally Env.leave
|> Eval.gcPass []
)
@ -606,7 +606,7 @@ evalFn args =
UserFunc
{ frameId = frameId
, lazyFn = lazyFn
, eagerFn = lazyFn >> Eval.andThen eval
, eagerFn = \_ -> lazyFn >> Eval.andThen eval
, isMacro = False
, meta = Nothing
}
@ -689,7 +689,7 @@ macroexpand expr =
case Env.get name env of
Ok (MalFunction (UserFunc fn)) ->
if fn.isMacro then
Left <| fn.eagerFn args
Left <| fn.eagerFn [] args
else
Right expr

19
elm/stepA_mal.elm
View File

@ -277,7 +277,7 @@ malEval args =
(\env ->
Eval.modifyEnv (Env.jump Env.globalFrameId)
|> Eval.andThen (\_ -> eval expr)
|> Eval.finally (Env.jump env.currentFrameId)
|> Eval.finally Env.leave
)
_ ->
@ -290,7 +290,7 @@ evalApply { frameId, bound, body } =
(\env ->
Eval.modifyEnv (Env.enter frameId bound)
|> Eval.andThen (\_ -> evalNoApply body)
|> Eval.finally (Env.leave env.currentFrameId)
|> Eval.finally Env.leave
|> Eval.gcPass
)
@ -368,9 +368,14 @@ evalNoApply ast =
_ ->
evalAst ast
in
debug "evalNoApply"
(\env -> printString env True ast)
(macroexpand ast |> Eval.andThen go)
macroexpand ast
|> Eval.andThen go
|> Eval.andThen
(\res ->
debug "evalNoApply"
(\env -> (printString env True ast) ++ " = " ++ (printString env True res))
(Eval.succeed res)
)
evalAst : MalExpr -> Eval MalExpr
@ -413,10 +418,10 @@ evalList list =
eval x
|> Eval.andThen
(\val ->
go rest (val :: acc)
Eval.pushRef val <| go rest (val :: acc)
)
in
go list []
Eval.withStack <| go list []
evalDef : List MalExpr -> Eval MalExpr

4
mal/core.mal
View File

@ -60,4 +60,6 @@
["atom?" atom?]
["deref" deref]
["reset!" reset!]
["swap!" swap!]])
["swap!" swap!]
["gc" gc]
["pr-env" pr-env]])