carp-lang/Carp
1
1
Fork 0
mirror of https://github.com/carp-lang/Carp.git synced 2024-09-17 16:38:14 +03:00
Code Issues Projects Releases Wiki Activity

Bug is fixed, tests run.

Browse Source
This commit is contained in:
Erik Svedäng 2020-05-04 11:50:49 +02:00
parent 7bcecd9b7c
commit 5ebd1abcc8
2 changed files with 39 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
examples/bugs.carp
View File

@ -146,16 +146,24 @@
;; (set! x 11)
;; (println* x))))
;;(defn make-array [] [1 2 3])
(macro-log "BUGS")
(defn make-array [] [1 2 3])
;; Nasty (and extremely simple!) reference error that apparently prevails
(defn f []
(ref [1 2 3]))
(ref (make-array)))
;; This also does not get detected:
;; (defn g []
;; (let []
;; &[1 2 3]))
(defn g []
(let []
(ref [1 2 3])))
;; (defn g []
;; &(make-array))
@ -163,5 +171,5 @@
;; (macro-log "--------")
;; (defn h []
;; (let [xs &(make-array)]
;; (let [xs (ref [1 2 3])]
;; 0))

45
src/Concretize.hs
View File

@ -663,31 +663,32 @@ manageMemory typeEnv globalEnv root =
case finalObj of
Left err -> Left err
Right ok -> let newInfo = fmap (\i -> i { infoDelete = deleteThese }) (info ok)
in Right (ok { info = newInfo }, deps)
in -- This final check of lifetimes works on the lifetimes mappings after analyzing the function form, and
-- after all the local variables in it have been deleted. This is needed for values that are created
-- directly in body position, e.g. (defn f [] &[1 2 3])
case evalState (checkThatRefTargetIsAlive ok) (MemState (Set.fromList []) [] (memStateLifetimes finalState)) of
Left err -> Left err
Right _ -> Right (ok { info = newInfo }, deps)
where visit :: XObj -> State MemState (Either TypeError XObj)
visit xobj =
do r <- case obj xobj of
Lst _ -> {-do-} visitList xobj
-- res <- visitList xobj
-- case res of
-- Right ok -> do addToLifetimesMappingsIfRef True ok
-- return res
-- Left err -> return (Left err)
Lst _ -> visitList xobj
Arr _ -> visitArray xobj
StaticArr _ -> visitStaticArray xobj
Str _ -> do manage xobj
addToLifetimesMappingsIfRef False xobj -- TODO: Should "internal = True" here?
addToLifetimesMappingsIfRef False xobj -- TODO: Should "internal = True" here? TODO: Possible to remove this one?
return (Right xobj)
Pattern _ -> do manage xobj
addToLifetimesMappingsIfRef False xobj
addToLifetimesMappingsIfRef False xobj -- TODO: Also possible to remove, *should* be superseeded by (***) below?
return (Right xobj)
_ ->
return (Right xobj)
case r of
Right ok -> do MemState _ _ m <- get
checkThatRefTargetIsAlive -- $ trace ("CHECKING " ++ pretty ok ++ " : " ++ showMaybeTy (ty xobj) ++ ", mappings: " ++ prettyLifetimeMappings m) $
ok
r <- checkThatRefTargetIsAlive ok -- $ trace ("CHECKING " ++ pretty ok ++ " : " ++ showMaybeTy (ty xobj) ++ ", mappings: " ++ prettyLifetimeMappings m) $
addToLifetimesMappingsIfRef True ok -- (***)
return r
Left err -> return (Left err)
visitArray :: XObj -> State MemState (Either TypeError XObj)
@ -1117,8 +1118,12 @@ manageMemory typeEnv globalEnv root =
performCheck lt
Just (FuncTy _ _ (VarTy lt)) ->
performCheck lt
-- HACK (not exhaustive):
Just (FuncTy _ (RefTy _ (VarTy lt)) _) ->
performCheck lt
_ ->
return (Right xobj)
return -- $ trace ("Won't check " ++ pretty xobj ++ " : " ++ show (ty xobj))
(Right xobj)
where performCheck :: String -> State MemState (Either TypeError XObj)
performCheck lt =
@ -1138,20 +1143,20 @@ manageMemory typeEnv globalEnv root =
--return (Right xobj)
return (Left (UsingDeadReference xobj deleterName))
_ ->
-- trace ("CAN use reference " ++ pretty xobj ++ " (with lifetime '" ++ lt ++ "', depending on " ++ show deleterName ++ ") at " ++ prettyInfoFromXObj xobj ++ ", it's not alive here:\n" ++ show xobj ++ "\nMappings: " ++ prettyLifetimeMappings lifetimeMappings ++ "\nAlive: " ++ show deleters ++ "\n") $
--trace ("CAN use reference " ++ pretty xobj ++ " (with lifetime '" ++ lt ++ "', depending on " ++ show deleterName ++ ") at " ++ prettyInfoFromXObj xobj ++ ", it's not alive here:\n" ++ show xobj ++ "\nMappings: " ++ prettyLifetimeMappings lifetimeMappings ++ "\nAlive: " ++ show deleters ++ "\n") $
return (Right xobj)
Just LifetimeOutsideFunction ->
--trace ("Lifetime OUTSIDE function: " ++ pretty xobj ++ " at " ++ prettyInfoFromXObj xobj) $
return (Right xobj)
Nothing ->
return (Right xobj)
--case xobj of
-- XObj (Sym _ (LookupLocal Capture)) _ _ ->
-- -- Ignore these for the moment! TODO: FIX!!!
-- return (Right xobj)
--_ ->
--trace ("Failed to find lifetime key (when checking) '" ++ lt ++ "' for " ++ pretty xobj ++ " in mappings at " ++ prettyInfoFromXObj xobj) $
--return (Right xobj)
-- case xobj of
-- XObj (Sym _ (LookupLocal Capture)) _ _ ->
-- -- Ignore these for the moment! TODO: FIX!!!
-- return (Right xobj)
-- _ ->
-- trace ("Failed to find lifetime key (when checking) '" ++ lt ++ "' for " ++ pretty xobj ++ " in mappings at " ++ prettyInfoFromXObj xobj) $
-- return (Right xobj)
visitLetBinding :: (XObj, XObj) -> State MemState (Either TypeError (XObj, XObj))
visitLetBinding (name, expr) =