InitialTypes.hs

module InitialTypes where

import Control.Monad.State
import Data.Either (fromRight)
import Env as E
import Info
import qualified Map
import Obj
import qualified Set
import TypeError
import Types
import Util

-- | Create a fresh type variable (eg. 'VarTy t0', 'VarTy t1', etc...)
genVarTyWithPrefix :: String -> State Integer Ty
genVarTyWithPrefix prefix =
  do
    x <- get
    put (x + 1)
    pure (VarTy (prefix ++ show x))

genVarTy :: State Integer Ty
genVarTy = genVarTyWithPrefix "t"

-- | Create a list of type variables with increasing names
genVarTys :: Int -> State Integer [Ty]
genVarTys n = replicateM n genVarTy

-- | Gives all type variables new names ("t<n>", counting from current state) while
--   still preserving the same name for type variables with a shared name.
--   Example: (t0, t1, t1) -> t0
--   becomes: (r2, r3, r3) -> r2
renameVarTys :: Ty -> State Integer Ty
renameVarTys rootType = do
  n <- get
  let (result, (n', _)) = runState (rename rootType) (n, Map.empty)
  put n'
  pure result
  where
    rename :: Ty -> State (Integer, Map.Map String Ty) Ty
    rename (FuncTy argTys retTy ltTy) = do
      ltTy' <- rename ltTy
      argTys' <- mapM rename argTys
      retTy' <- rename retTy
      pure (FuncTy argTys' retTy' ltTy')
    rename (VarTy v) = do
      (n, mappings) <- get
      case Map.lookup v mappings of
        Just found -> pure found
        Nothing -> do
          let varTy = VarTy ("r" ++ show n)
              newMappings = Map.insert v varTy mappings
          put (n + 1, newMappings)
          pure varTy
    rename (StructTy name tyArgs) = do
      tyArgs' <- mapM rename tyArgs
      name' <- rename name
      pure (StructTy name' tyArgs')
    rename (PointerTy x) = do
      x' <- rename x
      pure (PointerTy x')
    rename (RefTy x lt) = do
      x' <- rename x
      lt' <- rename lt
      pure (RefTy x' lt')
    rename x = pure x

-- | Adds initial types to a s-expression and all its sub-nodes.
-- | Example: (f 10) => <(<f : (Fn [Int] Bool>) <10 : Int>) : t0>
initialTypes :: TypeEnv -> Env -> XObj -> Either TypeError XObj
initialTypes typeEnv rootEnv root = evalState (visit rootEnv root) 0
  where
    visit :: Env -> XObj -> State Integer (Either TypeError XObj)
    visit env xobj = case xobjObj xobj of
      (Num t _) -> pure (Right (xobj {xobjTy = Just t}))
      (Bol _) -> pure (Right (xobj {xobjTy = Just BoolTy}))
      (C _) -> pure (Right xobj {xobjTy = Just CTy})
      (Str _) -> do
        lt <- genVarTy
        pure (Right (xobj {xobjTy = Just (RefTy StringTy lt)}))
      (Pattern _) -> do
        lt <- genVarTy
        pure (Right (xobj {xobjTy = Just (RefTy PatternTy lt)}))
      (Chr _) -> pure (Right (xobj {xobjTy = Just CharTy}))
      Break -> pure (Right (xobj {xobjTy = Just (FuncTy [] UnitTy StaticLifetimeTy)}))
      (Command _) -> pure (Right (xobj {xobjTy = Just DynamicTy}))
      (Lst _) -> visitList env xobj
      (Arr _) -> visitArray env xobj
      (StaticArr _) -> visitStaticArray env xobj
      (Dict _) -> visitDictionary env xobj
      (Sym symPath _) -> visitSymbol env xobj symPath
      (MultiSym _ paths) -> visitMultiSym env xobj paths
      (InterfaceSym _) -> visitInterfaceSym env xobj
      e@(Defn _) -> pure (Left (InvalidObj e xobj))
      Def -> pure (Left (InvalidObj Def xobj))
      DefDynamic -> pure (Left (InvalidObj DefDynamic xobj))
      e@(Fn _ _) -> pure (Left (InvalidObj e xobj))
      Let -> pure (Left (InvalidObj Let xobj))
      If -> pure (Left (InvalidObj If xobj))
      While -> pure (Left (InvalidObj While xobj))
      Do -> pure (Left (InvalidObj Do xobj))
      m@(Mod _ _) -> pure (Left (InvalidObj m xobj))
      e@(Deftype _) -> pure (Left (InvalidObj e xobj))
      e@(External _) -> pure (Left (InvalidObj e xobj))
      e@(ExternalType _) -> pure (Left (InvalidObj e xobj))
      e@(Deftemplate _) -> pure (Left (InvalidObj e xobj))
      e@(Instantiate _) -> pure (Left (InvalidObj e xobj))
      e@(Defalias _) -> pure (Left (InvalidObj e xobj))
      SetBang -> pure (Left (InvalidObj SetBang xobj))
      Macro -> pure (Left (InvalidObj Macro xobj))
      The -> pure (Left (InvalidObj The xobj))
      Dynamic -> pure (Left (InvalidObj Dynamic xobj))
      Ref -> pure (Left (InvalidObj Ref xobj))
      Deref -> pure (Left (InvalidObj Deref xobj))
      With -> pure (Left (InvalidObj With xobj))
      -- catchall case for exhaustive patterns
      unknown -> pure (Left (InvalidObj unknown xobj))
    visitSymbol :: Env -> XObj -> SymPath -> State Integer (Either TypeError XObj)
    visitSymbol e xobj@(XObj (Sym name LookupRecursive) _ _) _ =
      case E.searchValueBinder e name of
        -- If this recursive symbol is already typed in this environment, use that type.
        -- This is relevant for, e.g. recursive function calls.
        -- We need to use search here to check parents as our let-binding handling possibly puts recursive
        -- environments as the parent of a more local environment for the let bindings.
        Right (Binder _ found) -> pure (Right xobj {xobjTy = xobjTy found})
        -- Other recursive lookups are left untouched (this avoids problems with looking up the thing they're referring to)
        Left _ -> do
          freshTy <- genVarTy
          pure (Right xobj {xobjTy = Just freshTy})
    visitSymbol env xobj symPath =
      case symPath of
        -- Symbols with leading ? are 'holes'.
        SymPath _ name@('?' : _) -> pure (Right (xobj {xobjTy = Just (VarTy name)}))
        SymPath _ (':' : _) -> pure (Left (LeadingColon xobj))
        _ ->
          case E.searchValue env symPath of
            Right (foundEnv, binder) ->
              case xobjTy (binderXObj binder) of
                -- Don't rename internal symbols like parameters etc!
                Just theType
                  | envIsExternal foundEnv -> do
                    renamed <- renameVarTys theType
                    pure (Right (xobj {xobjTy = Just renamed}))
                  | otherwise -> pure (Right (xobj {xobjTy = Just theType}))
                Nothing -> pure (Left (SymbolMissingType xobj foundEnv))
            Left _ -> pure (Left (SymbolNotDefined symPath xobj env)) -- Gives the error message "Trying to refer to an undefined symbol ..."
    visitMultiSym :: Env -> XObj -> [SymPath] -> State Integer (Either TypeError XObj)
    visitMultiSym _ xobj@(XObj (MultiSym _ _) _ _) _ =
      do
        freshTy <- genVarTy
        pure (Right xobj {xobjTy = Just freshTy})
    visitMultiSym _ _ _ = error "visitmultisym"
    visitInterfaceSym :: Env -> XObj -> State Integer (Either TypeError XObj)
    visitInterfaceSym _ xobj@(XObj (InterfaceSym name) _ _) =
      do
        freshTy <- case getTypeBinder typeEnv name of
          Right (Binder _ (XObj (Lst [XObj (Interface interfaceSignature _) _ _, _]) _ _)) -> renameVarTys interfaceSignature
          Right (Binder _ x) -> error ("A non-interface named '" ++ name ++ "' was found in the type environment: " ++ pretty x)
          Left _ -> genVarTy
        pure (Right xobj {xobjTy = Just freshTy})
    visitInterfaceSym _ _ = error "visitinterfacesym"
    visitArray :: Env -> XObj -> State Integer (Either TypeError XObj)
    visitArray env (XObj (Arr xobjs) i _) =
      do
        visited <- mapM (visit env) xobjs
        arrayVarTy <- genVarTy
        pure $ do
          okVisited <- sequence visited
          Right (XObj (Arr okVisited) i (Just (StructTy (ConcreteNameTy (SymPath [] "Array")) [arrayVarTy])))
    visitArray _ _ = error "The function 'visitArray' only accepts XObj:s with arrays in them."
    visitStaticArray :: Env -> XObj -> State Integer (Either TypeError XObj)
    visitStaticArray env (XObj (StaticArr xobjs) i _) =
      do
        visited <- mapM (visit env) xobjs
        arrayVarTy <- genVarTy
        lt <- genVarTy
        pure $ do
          okVisited <- sequence visited
          Right (XObj (StaticArr okVisited) i (Just (RefTy (StructTy (ConcreteNameTy (SymPath [] "StaticArray")) [arrayVarTy]) lt)))
    visitStaticArray _ _ = error "The function 'visitStaticArray' only accepts XObj:s with arrays in them."
    visitDictionary :: Env -> XObj -> State Integer (Either TypeError XObj)
    visitDictionary env (XObj (Dict xobjs) i _) =
      do
        visited <- mapM (visit env) xobjs
        arrayVarTy <- genVarTy
        pure $ do
          okVisited <- sequence visited
          Right (XObj (Dict okVisited) i (Just (StructTy (ConcreteNameTy (SymPath [] "Dictionary")) [arrayVarTy])))
    visitDictionary _ _ = error "The function 'visitArray' only accepts XObj:s with dictionaries in them."
    getTys env argList =
      do
        argTypes <- genVarTys (length argList)
        returnType <- genVarTy
        funcScopeEnv <- extendEnvWithParamList env argList
        pure (argTypes, returnType, funcScopeEnv)
    visitList :: Env -> XObj -> State Integer (Either TypeError XObj)
    visitList env xobj@(XObj (Lst xobjs) i _) =
      case xobjs of
        -- Defn
        [defn@(XObj (Defn _) _ _), nameSymbol@(XObj (Sym (SymPath _ name) _) _ _), XObj (Arr argList) argsi argst, body] ->
          do
            (argTypes, returnType, funcScopeEnv) <- getTys env argList
            let funcTy = Just (FuncTy argTypes returnType StaticLifetimeTy)
                typedNameSymbol = nameSymbol {xobjTy = funcTy}
                -- TODO! After the introduction of 'LookupRecursive' this env shouldn't be needed anymore? (but it is for some reason...)
                envWithSelf = fromRight funcScopeEnv (E.insertX funcScopeEnv (SymPath [] name) typedNameSymbol)
            visitedBody <- visit envWithSelf body
            visitedArgs <- mapM (visit envWithSelf) argList
            pure $ do
              okBody <- visitedBody
              okArgs <- sequence visitedArgs
              pure (XObj (Lst [defn, nameSymbol, XObj (Arr okArgs) argsi argst, okBody]) i funcTy)
        [XObj (Defn _) _ _, XObj (Sym _ _) _ _, XObj (Arr _) _ _] -> pure (Left (NoFormsInBody xobj))
        XObj defn@(Defn _) _ _ : _ ->
          pure (Left (InvalidObjExample defn xobj "(defn <name> [<arguments>] <body>)"))
        -- Anonymous function bound to a let name
        -- Supports recursion by assigning the same type to recursive calls ("let-rec").
        [XObj LocalDef _ _, XObj (Sym path _) si _, XObj (Lst [fn@(XObj (Fn _ _) _ _), XObj (Arr argList) argsi argst, body]) _ _] ->
          do
            (argTypes, returnType, funcScopeEnv) <- getTys env argList
            lt <- genVarTy
            let funcTy = Just (FuncTy argTypes returnType lt)
                typedNameSymbol = XObj (Sym path LookupRecursive) si funcTy
                envWithSelf = fromRight funcScopeEnv (E.insertX funcScopeEnv path typedNameSymbol)
            visitedBody <- visit envWithSelf body
            visitedArgs <- mapM (visit envWithSelf) argList
            pure $ do
              okBody <- visitedBody
              okArgs <- sequence visitedArgs
              let final = XObj (Lst [fn, XObj (Arr okArgs) argsi argst, okBody]) i funcTy
              pure final --(trace ("FINAL: " ++ show final) final)
              -- Let bindings
        [XObj LocalDef _ _, _, value] ->
          visit env value
        -- Unbound anonymous Fn
        [fn@(XObj (Fn _ _) _ _), XObj (Arr argList) argsi argst, body] ->
          do
            (argTypes, returnType, funcScopeEnv) <- getTys env argList
            lt <- genVarTy
            let funcTy = Just (FuncTy argTypes returnType lt)
            visitedBody <- visit funcScopeEnv body
            visitedArgs <- mapM (visit funcScopeEnv) argList
            pure $ do
              okBody <- visitedBody
              okArgs <- sequence visitedArgs
              let final = XObj (Lst [fn, XObj (Arr okArgs) argsi argst, okBody]) i funcTy
              pure final --(trace ("FINAL: " ++ show final) final)
        [XObj (Fn _ _) _ _, XObj (Arr _) _ _] -> pure (Left (NoFormsInBody xobj)) -- TODO: Special error message for lambdas needed?
        XObj fn@(Fn _ _) _ _ : _ ->
          pure (Left (InvalidObjExample fn xobj "(fn [<arguments>] <body>)"))
        -- Def
        [def@(XObj Def _ _), nameSymbol, expression] ->
          do
            definitionType <- genVarTy
            visitedExpr <- visit env expression
            pure $ do
              okExpr <- visitedExpr
              pure (XObj (Lst [def, nameSymbol, okExpr]) i (Just definitionType))
        XObj Def _ _ : _ ->
          pure (Left (InvalidObjExample Def xobj "(def <name> <expression>)"))
        -- DefDynamic
        [def@(XObj DefDynamic _ _), nameSymbol, expression] ->
          pure $ pure (XObj (Lst [def, nameSymbol, expression]) i (Just DynamicTy))
        XObj DefDynamic _ _ : _ ->
          pure (Left (InvalidObjExample Def xobj "(defdynamic <name> <expression>"))
        -- Let binding
        [letExpr@(XObj Let _ _), XObj (Arr bindings) bindi bindt, body] ->
          do
            wholeExprType <- genVarTy
            letScopeEnv <- extendEnvWithLetBindings env bindings
            case letScopeEnv of
              Right okLetScopeEnv ->
                do
                  visitedBindings <- mapM (visit okLetScopeEnv) bindings
                  visitedBody <- visit okLetScopeEnv body
                  pure $ do
                    okBindings <- sequence visitedBindings
                    case getDuplicate [] okBindings of
                      Just dup -> Left (DuplicateBinding dup)
                      Nothing -> do
                        okBody <- visitedBody
                        Right (XObj (Lst [letExpr, XObj (Arr okBindings) bindi bindt, okBody]) i (Just wholeExprType))
              Left err -> pure (Left err)
          where
            getDuplicate _ [] = Nothing
            getDuplicate names (o@(XObj (Sym (SymPath _ x) _) _ _) : _ : xs) =
              if x `elem` names then Just o else getDuplicate (x : names) xs
            getDuplicate _ _ = error "getduplicate"
        [XObj Let _ _, XObj (Arr _) _ _] ->
          pure (Left (NoFormsInBody xobj))
        XObj Let _ _ : XObj (Arr _) _ _ : _ ->
          pure (Left (TooManyFormsInBody xobj))
        XObj Let _ _ : _ ->
          pure (Left (InvalidObjExample Let xobj "(let [<variable> <expression ...] <body>)"))
        -- If
        [ifExpr@(XObj If _ _), expr, ifTrue, ifFalse] ->
          do
            visitedExpr <- visit env expr
            visitedTrue <- visit env ifTrue
            visitedFalse <- visit env ifFalse
            returnType <- genVarTy
            pure $ do
              okExpr <- visitedExpr
              okTrue <- visitedTrue
              okFalse <- visitedFalse
              pure
                ( XObj
                    ( Lst
                        [ ifExpr,
                          okExpr,
                          okTrue,
                          okFalse
                        ]
                    )
                    i
                    (Just returnType)
                )
        XObj If _ _ : _ ->
          pure (Left (InvalidObjExample If xobj "(if <condition> <then-expression> <else-expression>)"))
        -- Match
        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
                      env' <- extendEnvWithCaseMatch env lhs'
                      visitedLhs <- visit env' lhs'
                      visitedRhs <- visit env' rhs
                      pure $ do
                        okLhs <- visitedLhs
                        okRhs <- visitedRhs
                        pure (okLhs, okRhs)
                  )
                  (pairwise cases)
            returnType <- genVarTy
            pure $ do
              okExpr <- visitedExpr
              okCases <- visitedCases
              let okCasesConcatenated = concatMap (\(a, b) -> [a, b]) okCases
              pure
                ( XObj
                    (Lst ([matchExpr, okExpr] ++ okCasesConcatenated))
                    i
                    (Just returnType)
                )
        XObj (Match m) _ _ : _ ->
          pure (Left (InvalidObjExample (Match m) xobj "(match <to-match> <condition> <clause> ...)"))
        -- While (always return Unit)
        [whileExpr@(XObj While _ _), expr, body] ->
          do
            visitedExpr <- visit env expr
            visitedBody <- visit env body
            pure $ do
              okExpr <- visitedExpr
              okBody <- visitedBody
              pure (XObj (Lst [whileExpr, okExpr, okBody]) i (Just UnitTy))
        [XObj While _ _, _] ->
          pure (Left (NoFormsInBody xobj))
        XObj While _ _ : _ ->
          pure (Left (TooManyFormsInBody xobj))
        -- Do
        doExpr@(XObj Do _ _) : expressions ->
          do
            t <- genVarTy
            visitedExpressions <- fmap sequence (mapM (visit env) expressions)
            pure $ do
              okExpressions <- visitedExpressions
              pure (XObj (Lst (doExpr : okExpressions)) i (Just t))
        -- Set!
        [setExpr@(XObj SetBang _ _), variable, value] ->
          do
            visitedVariable <- visit env variable
            visitedValue <- visit env value
            pure $ do
              okVariable <- visitedVariable
              okValue <- visitedValue
              pure (XObj (Lst [setExpr, okVariable, okValue]) i (Just UnitTy))
        XObj SetBang _ _ : _ ->
          pure (Left (InvalidObjExample SetBang xobj "(set! <variable> <new-value>)"))
        -- The
        [theExpr@(XObj The _ _), typeXObj, value] ->
          do
            visitedValue <- visit env value
            pure $ do
              okValue <- visitedValue
              case xobjToTy typeXObj of
                Just okType -> pure (XObj (Lst [theExpr, typeXObj, okValue]) i (Just okType))
                Nothing -> Left (NotAType typeXObj)
        XObj The _ _ : _ ->
          pure (Left (InvalidObjExample The xobj "(the <type> <expression>)"))
        -- Ref
        [refExpr@(XObj Ref _ _), value] ->
          do
            visitedValue <- visit env value
            lt <- case value of -- This is to not get lifetime errors when using globals. TODO: Is there a better way?!
              XObj (Sym _ (LookupGlobal _ _)) _ _ -> pure StaticLifetimeTy
              _
                | isLiteral value -> pure StaticLifetimeTy
                | otherwise -> genVarTy
            pure $ do
              okValue <- visitedValue
              let valueTy = case xobjTy okValue of
                    Just vt -> (Just (RefTy vt lt))
                    Nothing -> Nothing
              pure (XObj (Lst [refExpr, okValue]) i valueTy)
        -- Deref (error!)
        [XObj Deref _ _, _] ->
          pure (Left (CantUseDerefOutsideFunctionApplication xobj))
        -- Function application with Deref
        XObj (Lst [deref@(XObj Deref _ _), func]) xi _ : args ->
          -- TODO: Remove code duplication (taken from function application below)
          do
            t <- genVarTy
            derefTy <- genVarTy
            visitedFunc <- visit env func
            visitedArgs <- fmap sequence (mapM (visit env) args)
            pure $ do
              okFunc <- visitedFunc
              okArgs <- visitedArgs
              pure (XObj (Lst (XObj (Lst [deref, okFunc]) xi (Just derefTy) : okArgs)) i (Just t))
        -- Function application
        func : args ->
          do
            t <- genVarTy
            visitedFunc <- visit env func
            visitedArgs <- fmap sequence (mapM (visit env) args)
            pure $ do
              okFunc <- visitedFunc
              okArgs <- visitedArgs
              pure (XObj (Lst (okFunc : okArgs)) i (Just t))
        -- Empty list
        [] -> pure (Right xobj {xobjTy = Just UnitTy})
    visitList _ _ = error "Must match on list!"
    extendEnvWithLetBindings :: Env -> [XObj] -> State Integer (Either TypeError Env)
    extendEnvWithLetBindings env xobjs =
      let pairs = pairwise xobjs
          emptyInnerEnv =
            Env
              { envBindings = Map.empty,
                envParent = Just env,
                envModuleName = Nothing,
                envUseModules = Set.empty,
                envMode = InternalEnv,
                envFunctionNestingLevel = envFunctionNestingLevel env
              }
       in -- Need to fold (rather than map) to make the previous bindings accessible to the later ones, i.e. (let [a 100 b a] ...)
          foldM createBinderForLetPair (Right emptyInnerEnv) pairs
      where
        -- Cast binders to Local Defs so that we can account for recursion ("let-rec").
        -- A local def carries the binder name along with its value, so we can appropriately type recursive uses.
        -- e.g. (let [f (fn [x] (if (= x 1) x (f (dec x))))])
        createBinderForLetPair :: Either TypeError Env -> (XObj, XObj) -> State Integer (Either TypeError Env)
        createBinderForLetPair envOrErr (sym, expr) =
          case envOrErr of
            Left err -> pure (Left err)
            Right env' ->
              case xobjObj sym of
                (Sym (SymPath _ name) _) ->
                  do
                    visited <- visit env' (toLocalDef name expr)
                    pure
                      ( join
                          (replaceLeft (InvalidLetBinding xobjs (sym, expr)) . E.insert env' (SymPath [] name) . Binder emptyMeta <$> visited)
                      )
                _ -> pure (Left (InvalidLetBinding xobjs (sym, expr)))
    extendEnvWithParamList :: Env -> [XObj] -> State Integer Env
    extendEnvWithParamList env xobjs =
      do
        binders' <- mapM createBinderForParam xobjs
        pure
          Env
            { envBindings = Map.fromList binders',
              envParent = Just env,
              envModuleName = Nothing,
              envUseModules = Set.empty,
              envMode = InternalEnv,
              envFunctionNestingLevel = envFunctionNestingLevel env
            }
      where
        createBinderForParam :: XObj -> State Integer (String, Binder)
        createBinderForParam xobj =
          case xobjObj xobj of
            (Sym (SymPath _ name) _) ->
              do
                t <- genVarTy
                let xobjWithTy = xobj {xobjTy = Just t}
                pure (name, Binder emptyMeta xobjWithTy)
            _ -> error "Can't create binder for non-symbol parameter."
    extendEnvWithCaseMatch :: Env -> XObj -> State Integer Env
    extendEnvWithCaseMatch env caseRoot =
      do
        binders' <- createBindersForCaseVariable caseRoot
        pure
          Env
            { envBindings = Map.fromList binders',
              envParent = Just env,
              envModuleName = Nothing,
              envUseModules = Set.empty,
              envMode = InternalEnv,
              envFunctionNestingLevel = envFunctionNestingLevel env
            }
      where
        createBindersForCaseVariable :: XObj -> State Integer [(String, Binder)]
        createBindersForCaseVariable xobj@(XObj (Sym (SymPath _ name) _) _ _) = createBinderInternal xobj name
        createBindersForCaseVariable xobj@(XObj (MultiSym name _) _ _) = createBinderInternal xobj name
        createBindersForCaseVariable xobj@(XObj (InterfaceSym name) _ _) = createBinderInternal xobj name
        createBindersForCaseVariable (XObj (Lst lst) _ _) = do
          binders' <- mapM createBindersForCaseVariable lst
          pure (concat binders')
        createBindersForCaseVariable (XObj Ref _ _) = pure []
        createBindersForCaseVariable x = error ("Can't create binder for non-symbol in 'case' variable match:" ++ show x) -- TODO: Should use proper error mechanism
        createBinderInternal :: XObj -> String -> State Integer [(String, Binder)]
        createBinderInternal xobj name =
          if isVarName name
            then -- A variable that will bind to something:
            do
              freshTy <- genVarTy
              pure [(name, Binder emptyMeta xobj {xobjTy = Just freshTy})]
            else -- Tags for the sumtypes won't bind to anything:
              pure []

uniquifyWildcardNames :: XObj -> XObj
uniquifyWildcardNames (XObj (Sym (SymPath [] "_") mode) (Just i) t) =
  let uniqueName = "wildcard_" ++ show (infoIdentifier i)
   in XObj (Sym (SymPath [] uniqueName) mode) (Just i) t
uniquifyWildcardNames (XObj (Lst xobjs) i t) =
  XObj (Lst (map uniquifyWildcardNames xobjs)) i t
uniquifyWildcardNames (XObj (Arr xobjs) i t) =
  XObj (Arr (map uniquifyWildcardNames xobjs)) i t
uniquifyWildcardNames x =
  x

-- | Help our programmer friend using Carp to add/remove parens around the lhs of a match
helpWithParens :: XObj -> XObj
helpWithParens xobj@(XObj (Sym (SymPath _ name) _) _ _)
  | isVarName name = xobj -- Don't wrap
  | otherwise = wrapInParens xobj
helpWithParens outer@(XObj (Lst [inner@(XObj (Sym (SymPath _ name) _) _ _)]) _ _)
  | isVarName name = inner -- Unwrap
  | otherwise = outer -- Keep wrapped
helpWithParens xobj =
  wrapInParens xobj