diff --git a/examples/temp.carp b/examples/temp.carp index 84ea9258..0cd0e096 100644 --- a/examples/temp.carp +++ b/examples/temp.carp @@ -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)) diff --git a/src/Emit.hs b/src/Emit.hs index 3cfae744..df15db3f 100644 --- a/src/Emit.hs +++ b/src/Emit.hs @@ -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 ++ "; " diff --git a/src/GenerateConstraints.hs b/src/GenerateConstraints.hs index 55542a67..95086a4c 100644 --- a/src/GenerateConstraints.hs +++ b/src/GenerateConstraints.hs @@ -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] -> diff --git a/src/Infer.hs b/src/Infer.hs index bf4bdf91..a8030533 100644 --- a/src/Infer.hs +++ b/src/Infer.hs @@ -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