Added a variation on match; match-ref.

examples/temp.carp

@@ -64,6 +64,6 @@
 (defn main []
   (let [s (Just @"Yo")
         r &s]
-    (match r
-      (ref (Just x)) (IO.println "just!")
-      (ref (Nothing)) (IO.println "nada"))))
+    (match-ref r
+      (Just x) (IO.println "just!")
+      (Nothing) (IO.println "nada"))))

src/Concretize.hs

@@ -190,7 +190,7 @@ concretizeXObj allowAmbiguityRoot typeEnv rootEnv visitedDefinitions root =
          return $ do okVisitedValue <- visitedValue
                      return [theExpr, typeXObj, okVisitedValue]
 
-    visitList allowAmbig level env matchXObj@(XObj (Lst (matchExpr@(XObj Match _ _) : expr : rest)) _ _) =
+    visitList allowAmbig level env matchXObj@(XObj (Lst (matchExpr@(XObj (Match _) _ _) : expr : rest)) _ _) =
       do concretizeTypeOfXObj typeEnv expr
          visitedExpr <- visit allowAmbig level env expr
          mapM_ (concretizeTypeOfXObj typeEnv . snd) (pairwise rest)
@@ -971,7 +971,7 @@ manageMemory typeEnv globalEnv root =
                              okFalse <- visitedFalse
                              return (XObj (Lst [ifExpr, okExpr, del okTrue delsTrue, del okFalse delsFalse]) i t)
 
-            matchExpr@(XObj Match _ _) : expr : cases ->
+            matchExpr@(XObj (Match _) _ _) : expr : cases ->
               -- General idea of how to figure out what to delete in a 'match' statement:
               -- 1. Visit each case and investigate which variables are deleted in each one of the cases
               -- 2. Variables deleted in at least one case has to be deleted in all, so make a union U of all such vars

src/Emit.hs

@@ -291,7 +291,7 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo
                      return ifRetVar
 
             -- Match
-            XObj Match _ _ : expr@(XObj _ (Just exprInfo) (Just exprTy)) : rest ->
+            XObj (Match _) _ _ : expr@(XObj _ (Just exprInfo) (Just exprTy)) : rest ->
               let indent' = indent + indentAmount
                   retVar = freshVar i
                   isNotVoid = t /= Just UnitTy
@@ -368,7 +368,7 @@ toC toCMode (Binder meta root) = emitterSrc (execState (visit startingIndent roo
                     quoteBackslashes ('\\':r) = "\\\\" ++ quoteBackslashes r
                     quoteBackslashes (x:r) = x : quoteBackslashes r
 
-            XObj Match _ _ : _ ->
+            XObj (Match _) _ _ : _ ->
               error "Fell through match."
 
             -- While

src/Expand.hs

@@ -102,7 +102,7 @@ expand eval ctx xobj =
                         Left err -> return (newCtx, Left err)
                         Right okX -> return (newCtx, Right (l ++ [[n, okX]]))
 
-        matchExpr@(XObj Match _ _) : (expr : rest)
+        matchExpr@(XObj (Match _) _ _) : (expr : rest)
           | null rest ->
               return (evalError ctx "I encountered a `match` without forms" (info xobj))
           | even (length rest) ->

src/GenerateConstraints.hs

@@ -99,7 +99,7 @@ genConstraints globalEnv root rootSig = fmap sort (gen root)
                                         insideTrueConstraints ++ insideFalseConstraints)
 
                            -- Match
-                           XObj Match _ _ : expr : cases ->
+                           XObj (Match matchMode) _ _ : expr : cases ->
                              do insideExprConstraints <- gen expr
                                 casesLhsConstraints <- fmap join (mapM (gen . fst) (pairwise cases))
                                 casesRhsConstraints <- fmap join (mapM (gen .snd) (pairwise cases))
@@ -137,6 +137,11 @@ genConstraints globalEnv root rootSig = fmap sort (gen root)
                                         returnConstraints ++
                                         exprConstraints)
 
+                                  where wrapTyInRefIfMatchingRef t =
+                                          case matchMode of
+                                            MatchValue -> t
+                                            MatchRef -> RefTy t (VarTy "whatever")
+
                            -- While
                            [XObj While _ _, expr, body] ->
                              do insideConditionConstraints <- gen expr

src/InitialTypes.hs

@@ -261,7 +261,7 @@ initialTypes typeEnv rootEnv root = evalState (visit rootEnv root) 0
         XObj If _ _ : _ -> return (Left (InvalidObj If xobj))
 
         -- Match
-        matchExpr@(XObj Match _ _) : expr : cases ->
+        matchExpr@(XObj (Match _) _ _) : expr : cases ->
           do visitedExpr <- visit env expr
              visitedCases <- sequence <$>
               mapM (\(lhs, rhs) -> do let lhs' = uniquifyWildcardNames (helpWithParens lhs) -- Add parens if missing
@@ -279,7 +279,7 @@ initialTypes typeEnv rootEnv root = evalState (visit rootEnv root) 0
                          return (XObj (Lst ([matchExpr, okExpr] ++ okCasesConcatenated))
                                   i (Just returnType))
 
-        XObj Match _ _ : _ -> return (Left (InvalidObj Match xobj))
+        XObj (Match m) _ _ : _ -> return (Left (InvalidObj (Match m) xobj))
 
         -- While (always return Unit)
         [whileExpr@(XObj While _ _), expr, body] ->

src/Obj.hs

@@ -43,6 +43,8 @@ isLookupLocal :: SymbolMode -> Bool
 isLookupLocal (LookupLocal _) = True
 isLookupLocal _ = False
 
+data MatchMode = MatchValue | MatchRef deriving (Eq, Show)
+
 -- | The canonical Lisp object.
 data Obj = Sym SymPath SymbolMode
          | MultiSym String [SymPath] -- refering to multiple functions with the same name
@@ -65,7 +67,7 @@ data Obj = Sym SymPath SymbolMode
          | While
          | Break
          | If
-         | Match
+         | Match MatchMode
          | Mod Env
          | Deftype Ty
          | DefSumtype Ty
@@ -287,7 +289,8 @@ pretty = visit 0
             Fn _ captures -> "fn" ++ " <" ++ prettyCaptures captures ++ ">"
             Closure elem _ -> "closure<" ++ pretty elem ++ ">"
             If -> "if"
-            Match -> "match"
+            Match MatchValue -> "match"
+            Match MatchRef -> "match-ref"
             While -> "while"
             Do -> "do"
             Let -> "let"
@@ -347,7 +350,7 @@ prettyUpTo max xobj =
             Fn _ captures -> ">"
             Closure elem _ -> ">"
             If -> ""
-            Match -> ""
+            Match _ -> ""
             While -> ""
             Do -> ""
             Let -> ""

src/Parsing.hs

@@ -230,7 +230,8 @@ symbol = do i <- createInfo
                 "let" -> return (XObj Let i Nothing)
                 "break" -> return (XObj Break i Nothing)
                 "if" -> return (XObj If i Nothing)
-                "match" -> return (XObj Match i Nothing)
+                "match" -> return (XObj (Match MatchValue) i Nothing)
+                "match-ref" -> return (XObj (Match MatchRef) i Nothing)
                 "true" -> return (XObj (Bol True) i Nothing)
                 "false" -> return (XObj (Bol False) i Nothing)
                 "address" -> return (XObj Address i Nothing)

src/Qualify.hs

@@ -65,7 +65,7 @@ setFullyQualifiedSymbols typeEnv globalEnv env (XObj (Lst [letExpr@(XObj Let _ _
                     newBody = setFullyQualifiedSymbols typeEnv globalEnv innerEnv' body
                 in  XObj (Lst [letExpr, XObj (Arr bindings') bindi bindt, newBody]) i t
 
-setFullyQualifiedSymbols typeEnv globalEnv env (XObj (Lst (matchExpr@(XObj Match _ _) : expr : casesXObjs)) i t) =
+setFullyQualifiedSymbols typeEnv globalEnv env (XObj (Lst (matchExpr@(XObj (Match _) _ _) : expr : casesXObjs)) i t) =
   if even (length casesXObjs)
   then let newExpr = setFullyQualifiedSymbols typeEnv globalEnv env expr
            Just ii = i