mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-11 05:25:28 +03:00
Fixed the issue with nested capture and nested lambdas
This commit is contained in:
parent
3a04d19535
commit
4ab29d84ac
2
examples/nested_lambdas.carp
Normal file
2
examples/nested_lambdas.carp
Normal file
@ -0,0 +1,2 @@
|
||||
(defn my-curry [f] (fn [x] (fn [y] (f x y))))
|
||||
(defn double-curry [f] (fn [x] (fn [y] (fn [z] (f x y z)))))
|
@ -43,6 +43,7 @@ done
|
||||
./carp.sh ./examples/guessing.carp -b
|
||||
./carp.sh ./examples/no_core.carp --no-core --no-profile -b
|
||||
./carp.sh ./examples/check_malloc.carp -b
|
||||
./carp.sh ./examples/nested_lambdas.carp -b
|
||||
|
||||
# Run tests which rely on SDL unless the `--no_sdl` argument was passed in
|
||||
if [[ ${NO_SDL} -eq 0 ]]; then
|
||||
|
@ -110,8 +110,7 @@ concretizeXObj allowAmbiguityRoot typeEnv rootEnv visitedDefinitions root =
|
||||
let -- Analyse the body of the lambda to find what variables it captures
|
||||
capturedVarsRaw = collectCapturedVars okBody
|
||||
-- and then remove the captures that are actually our arguments
|
||||
capturedVars = filter (\xobj -> obj xobj `notElem` argObjs)
|
||||
capturedVarsRaw
|
||||
capturedVars = filter (\xobj -> obj (toGeneralSymbol xobj) `notElem` argObjs) capturedVarsRaw
|
||||
|
||||
-- Create a new (top-level) function that will be used when the lambda is called.
|
||||
-- Its name will contain the name of the (normal, non-lambda) function it's contained within,
|
||||
@ -307,16 +306,25 @@ concretizeXObj allowAmbiguityRoot typeEnv rootEnv visitedDefinitions root =
|
||||
Nothing ->
|
||||
error ("No interface named '" ++ name ++ "' found.")
|
||||
|
||||
toGeneralSymbol :: XObj -> XObj
|
||||
toGeneralSymbol (XObj (Sym path _) _ t) = XObj (Sym path Symbol) (Just dummyInfo) t
|
||||
toGeneralSymbol x = error ("Can't convert this to a general symbol: " ++ show x)
|
||||
|
||||
-- | Find all lookups in a lambda body that should be captured by its environment
|
||||
collectCapturedVars :: XObj -> [XObj]
|
||||
collectCapturedVars root = removeDuplicates (map toGeneralSymbol (visit root))
|
||||
collectCapturedVars root = removeDuplicates (map decreaseCaptureLevel (visit root))
|
||||
where
|
||||
removeDuplicates :: Ord a => [a] -> [a]
|
||||
removeDuplicates = Set.toList . Set.fromList
|
||||
|
||||
toGeneralSymbol :: XObj -> XObj
|
||||
toGeneralSymbol (XObj (Sym path _) _ t) = XObj (Sym path Symbol) (Just dummyInfo) t
|
||||
toGeneralSymbol x = error ("Can't convert this to a general symbol: " ++ show x)
|
||||
decreaseCaptureLevel :: XObj -> XObj
|
||||
decreaseCaptureLevel (XObj (Sym path lookup) _ ty) =
|
||||
XObj (Sym path (case lookup of
|
||||
Symbol -> Symbol
|
||||
LookupLocal NoCapture -> Symbol
|
||||
LookupLocal (Capture n) -> if n <= 1 then Symbol
|
||||
else LookupLocal (Capture (n-1))))
|
||||
(Just dummyInfo) ty
|
||||
|
||||
visit xobj =
|
||||
case obj xobj of
|
||||
@ -325,7 +333,7 @@ collectCapturedVars root = removeDuplicates (map toGeneralSymbol (visit root))
|
||||
(Lst _) -> visitList xobj
|
||||
(Arr _) -> visitArray xobj
|
||||
-- TODO: Static Arrays!
|
||||
(Sym path (LookupLocal Capture)) -> [xobj]
|
||||
(Sym path (LookupLocal (Capture _))) -> [xobj]
|
||||
_ -> []
|
||||
|
||||
visitList :: XObj -> [XObj]
|
||||
@ -506,7 +514,7 @@ modeFromPath env p =
|
||||
RecursionEnv -> LookupRecursive
|
||||
_ -> LookupLocal
|
||||
(if envFunctionNestingLevel e < envFunctionNestingLevel env
|
||||
then Capture
|
||||
then Capture (envFunctionNestingLevel e - envFunctionNestingLevel env)
|
||||
else NoCapture)
|
||||
Nothing -> error ("Couldn't find " ++ show p ++ " in env:\n" ++ prettyEnvironmentChain env)
|
||||
|
||||
@ -865,7 +873,7 @@ manageMemory typeEnv globalEnv root =
|
||||
LookupGlobal _ _ -> return ()
|
||||
|
||||
case okMode of
|
||||
LookupLocal Capture ->
|
||||
LookupLocal (Capture _) ->
|
||||
return (Left (CannotSetVariableFromLambda variable setbangExpr))
|
||||
_ ->
|
||||
return $ do okValue <- visitedValue
|
||||
@ -1252,7 +1260,7 @@ manageMemory typeEnv globalEnv root =
|
||||
isSymbolThatCaptures :: XObj -> Bool
|
||||
isSymbolThatCaptures xobj =
|
||||
case xobj of
|
||||
XObj (Sym _ (LookupLocal Capture)) _ _ -> True
|
||||
XObj (Sym _ (LookupLocal (Capture _))) _ _ -> True
|
||||
_ -> False
|
||||
|
||||
unmanage :: XObj -> State MemState (Either TypeError ())
|
||||
|
11
src/Emit.hs
11
src/Emit.hs
@ -177,7 +177,7 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo
|
||||
appendToSrc (addIndent indent ++ "Lambda " ++ var ++ " = { .callback = " ++ pathToC path ++ ", .env = NULL, .delete = NULL, .copy = NULL }; //" ++ show sym ++ "\n")
|
||||
return var
|
||||
else case lookupMode of
|
||||
LookupLocal Capture -> return ("_env->" ++ pathToC path)
|
||||
LookupLocal (Capture _) -> return ("_env->" ++ pathToC path)
|
||||
_ -> return (pathToC path)
|
||||
|
||||
visitSymbol _ xobj@(XObj (Sym path _) Nothing _) = error ("Symbol missing info: " ++ show xobj)
|
||||
@ -221,9 +221,12 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo
|
||||
when needEnv $
|
||||
do appendToSrc (addIndent indent ++ tyToC lambdaEnvType ++ " *" ++ lambdaEnvName ++
|
||||
" = CARP_MALLOC(sizeof(" ++ tyToC lambdaEnvType ++ "));\n")
|
||||
mapM_ (\(XObj (Sym path _) _ _) ->
|
||||
appendToSrc (addIndent indent ++ lambdaEnvName ++ "->" ++
|
||||
pathToC path ++ " = " ++ pathToC path ++ ";\n"))
|
||||
mapM_ (\(XObj (Sym path lookupMode) _ _) ->
|
||||
appendToSrc (addIndent indent ++ lambdaEnvName ++ "->" ++
|
||||
pathToC path ++ " = " ++
|
||||
(case lookupMode of
|
||||
LookupLocal (Capture _) -> "_env->" ++ pathToC path
|
||||
_ -> pathToC path) ++ ";\n"))
|
||||
capturedVars
|
||||
appendToSrc (addIndent indent ++ "Lambda " ++ retVar ++ " = {\n")
|
||||
appendToSrc (addIndent indent ++ " .callback = " ++ callbackMangled ++ ",\n")
|
||||
|
@ -25,7 +25,7 @@ data DefinitionMode = AVariable
|
||||
|
||||
-- | For local lookups, does the variable live in the current function or is it captured from outside it's body?
|
||||
data CaptureMode = NoCapture
|
||||
| Capture
|
||||
| Capture Int
|
||||
deriving (Eq, Show, Ord)
|
||||
|
||||
-- | A symbol knows a bit about what it refers to - is it a local scope or a global one? (the latter include modules).
|
||||
|
@ -131,7 +131,7 @@ setFullyQualifiedSymbols typeEnv globalEnv localEnv xobj@(XObj (Sym path _) i t)
|
||||
XObj (InterfaceSym name) i t
|
||||
|
||||
captureOrNot foundEnv = if envFunctionNestingLevel foundEnv < envFunctionNestingLevel localEnv
|
||||
then Capture
|
||||
then Capture (envFunctionNestingLevel localEnv - envFunctionNestingLevel foundEnv)
|
||||
else NoCapture
|
||||
|
||||
doesNotBelongToAnInterface :: Bool -> Env -> XObj
|
||||
|
Loading…
Reference in New Issue
Block a user