Trying to make setting a dereferenced ref work.

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))

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 ++ "; "

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] ->

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