carp-lang/Carp
1
1
Fork 0
mirror of https://github.com/carp-lang/Carp.git synced 2024-11-04 01:25:04 +03:00
Code Issues Projects Releases Wiki Activity

fix: allow dynamic closures to mutate the global env (#1184)

Browse Source
This commit is contained in:
Scott Olsen 2021-03-09 17:30:49 -05:00 committed by GitHub
parent 3ab7e229ae
commit 816eb65474
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 26 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
src/Eval.hs
View File

@ -242,8 +242,8 @@ eval ctx xobj@(XObj o info ty) preference resolver =
let newGlobals = (contextGlobalEnv newCtx) <> (contextGlobalEnv c)
newTypes = TypeEnv $ (getTypeEnv (contextTypeEnv newCtx)) <> (getTypeEnv (contextTypeEnv c))
updater = replaceHistory' (contextHistory ctx) . replaceGlobalEnv' newGlobals . replaceTypeEnv' newTypes
(_, res) <- apply (updater c) body params okArgs
pure (newCtx, res)
(ctx', res) <- apply (updater c) body params okArgs
pure (replaceGlobalEnv newCtx (contextGlobalEnv ctx'), res)
Left err -> pure (newCtx, Left err)
XObj (Lst [XObj Dynamic _ _, sym, XObj (Arr params) _ _, body]) i _ : args ->
case checkArity (getName sym) params args of
@ -267,37 +267,37 @@ eval ctx xobj@(XObj o info ty) preference resolver =
Left _ -> pure (ctx, res)
[XObj (Lst [XObj (Command (NullaryCommandFunction nullary)) _ _, _, _]) _ _] ->
do
(_, evaledArgs) <- foldlM successiveEval (ctx, Right []) []
(c, evaledArgs) <- foldlM successiveEval (ctx, Right []) []
case evaledArgs of
Right [] -> nullary ctx
Right [] -> nullary c
Right _ -> error "eval nullary"
Left err -> pure (ctx, Left err)
[XObj (Lst [XObj (Command (UnaryCommandFunction unary)) _ _, _, _]) _ _, x] ->
do
(_, evaledArgs) <- foldlM successiveEval (ctx, Right []) [x]
(c, evaledArgs) <- foldlM successiveEval (ctx, Right []) [x]
case evaledArgs of
Right [x'] -> unary ctx x'
Right [x'] -> unary c x'
Right _ -> error "eval unary"
Left err -> pure (ctx, Left err)
[XObj (Lst [XObj (Command (BinaryCommandFunction binary)) _ _, _, _]) _ _, x, y] ->
do
(_, evaledArgs) <- foldlM successiveEval (ctx, Right []) [x, y]
(c, evaledArgs) <- foldlM successiveEval (ctx, Right []) [x, y]
case evaledArgs of
Right [x', y'] -> binary ctx x' y'
Right [x', y'] -> binary c x' y'
Right _ -> error "eval binary"
Left err -> pure (ctx, Left err)
[XObj (Lst [XObj (Command (TernaryCommandFunction ternary)) _ _, _, _]) _ _, x, y, z] ->
do
(_, evaledArgs) <- foldlM successiveEval (ctx, Right []) [x, y, z]
(c, evaledArgs) <- foldlM successiveEval (ctx, Right []) [x, y, z]
case evaledArgs of
Right [x', y', z'] -> ternary ctx x' y' z'
Right [x', y', z'] -> ternary c x' y' z'
Right _ -> error "eval ternary"
Left err -> pure (ctx, Left err)
XObj (Lst [XObj (Command (VariadicCommandFunction variadic)) _ _, _, _]) _ _ : args ->
do
(_, evaledArgs) <- foldlM successiveEval (ctx, Right []) args
(c, evaledArgs) <- foldlM successiveEval (ctx, Right []) args
case evaledArgs of
Right xs -> variadic ctx xs
Right xs -> variadic c xs
Left err -> pure (ctx, Left err)
XObj (Lst [XObj (Command _) _ _, sym, XObj (Arr params) _ _]) i _ : args ->
badArity (getName sym) params args i

14
test/dynamic-closures.carp
View File

@ -2,6 +2,7 @@
(use Test)
(defdynamic x 400)
(defdynamic z 0)
;; close over a global variable
(defdynamic closure-one
@ -23,6 +24,10 @@
(defdynamic closure-five
(fn [] (let [x 5] (fn [] x))))
;; closures can update the global environment (issue #1181)
(defdynamic closure-six
(fn [] (set! z (inc z))))
(defdynamic y 500)
(defmacro test-closure-one [] (closure-one))
@ -30,6 +35,11 @@
(defmacro test-closure-three [] (closure-three))
(defmacro test-closure-four [] (closure-four))
(defmacro test-closure-five [] ((closure-five)))
(defmacro test-closure-six []
(do (closure-six)
(closure-six)
(closure-six)
z))
;; Change the global value of x (closed over in closure-one)
(set! x 1000)
@ -55,4 +65,8 @@
5
(test-closure-five)
"nested closures prefer closed-over bindings")
(assert-equal test
3
(test-closure-six)
"closures can update the global environment")
)