mirror of
https://github.com/carp-lang/Carp.git
synced 2024-10-11 12:37:32 +03:00
Trying to make setting a dereferenced ref work.
This commit is contained in:
parent
26887f3716
commit
7679b53a98
@ -17,7 +17,11 @@
|
||||
(do (set! r &s2)
|
||||
(IO.println r))))
|
||||
|
||||
(defn )
|
||||
(defn set-derefed []
|
||||
(let [s @"hello"
|
||||
r &s]
|
||||
(do (set! @r @"new")
|
||||
(IO.println &s))))
|
||||
|
||||
(defn main []
|
||||
)
|
||||
(set-derefed))
|
||||
|
@ -35,6 +35,7 @@ data ToCError = InvalidParameter XObj
|
||||
| UnresolvedMultiSymbol XObj
|
||||
| UnresolvedInterfaceSymbol XObj
|
||||
| UnresolvedGenericType XObj
|
||||
| CannotSet XObj
|
||||
|
||||
instance Show ToCError where
|
||||
show (InvalidParameter xobj) = "Invalid parameter: " ++ show (obj xobj)
|
||||
@ -53,6 +54,7 @@ instance Show ToCError where
|
||||
" at " ++ prettyInfoFromXObj xobj
|
||||
show (UnresolvedGenericType xobj@(XObj _ _ (Just t))) =
|
||||
"Found unresolved generic type '" ++ show t ++ "' at " ++ prettyInfoFromXObj xobj
|
||||
show (CannotSet xobj) = "Can't emit code for setting " ++ pretty xobj ++ " at " ++ prettyInfoFromXObj xobj
|
||||
|
||||
data ToCMode = Functions | Globals | All deriving Show
|
||||
|
||||
@ -263,9 +265,9 @@ toC toCMode root = emitterSrc (execState (visit startingIndent root) (EmitterSta
|
||||
do valueVar <- visit indent value
|
||||
let properVariableName =
|
||||
case variable of
|
||||
(XObj (Lst (XObj Ref _ _ : symObj@(XObj (Sym sym _) _ _) : _)) _ _) -> pathToC sym
|
||||
(XObj (Lst (XObj (Sym (SymPath _ "copy") _) _ _ : symObj@(XObj (Sym sym _) _ _) : _)) _ _) -> "*" ++ pathToC sym
|
||||
(XObj (Sym sym _) _ _) -> pathToC sym
|
||||
v -> error ("Can't 'set!' this: " ++ show v)
|
||||
v -> error (show (CannotSet variable)) -- TODO: Should return either here.
|
||||
Just varInfo = info variable
|
||||
delete indent varInfo
|
||||
appendToSrc (addIndent indent ++ properVariableName ++ " = " ++ valueVar ++ "; "
|
||||
|
@ -101,10 +101,11 @@ genConstraints root = fmap sort (gen root)
|
||||
-- Set!
|
||||
[XObj SetBang _ _, variable, value] ->
|
||||
do insideValueConstraints <- gen value
|
||||
insideVariableConstraints <- gen variable
|
||||
variableType <- toEither (ty variable) (ExpressionMissingType variable)
|
||||
valueType <- toEither (ty value) (ExpressionMissingType value)
|
||||
let sameTypeConstraint = Constraint variableType valueType variable value OrdSetBang
|
||||
return (sameTypeConstraint : insideValueConstraints)
|
||||
return (sameTypeConstraint : insideValueConstraints ++ insideVariableConstraints)
|
||||
|
||||
-- The
|
||||
[XObj The _ _, _, value] ->
|
||||
|
@ -52,7 +52,7 @@ annotateUntilDone typeEnv globalEnv xobj deps limiter =
|
||||
annotateOne :: TypeEnv -> Env -> XObj -> Bool -> Either TypeError (XObj, [XObj])
|
||||
annotateOne typeEnv env xobj allowAmbiguity = do
|
||||
constraints <- genConstraints xobj
|
||||
mappings <- solveConstraintsAndConvertErrorIfNeeded constraints --(trace ("CONSTRAINTS:\n" ++ joinWith "\n" (map show constraints)) constraints)
|
||||
mappings <- solveConstraintsAndConvertErrorIfNeeded constraints -- (trace (getName xobj ++ "CONSTRAINTS:\n" ++ joinWith "\n" (map show constraints)) constraints)
|
||||
typed <- assignTypes mappings xobj
|
||||
concretizeXObj allowAmbiguity typeEnv env [] typed
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user