Differentiate between user-provided and temporary variables (#178)

Differentiate between user-provided and temporary variables

This allows the codegen to make /slightly/ more reasonable (and more
importantly, deterministic) code.

Author: SquidDev

compiler/Repl.hs

@@ -282,8 +282,8 @@ execString name line = do
               vs' <- for vs $ \(v, _) -> do
                 let Just (_, vs) = VarMap.lookup v (emit' ^. B.topVars)
                 repr <- traverse (valueRepr . evalExpr . B.unsimple) vs
-                let CoVar id nam _ = v
-                    var = S.TgName nam id
+                let CoVar id _ _ = v
+                    var = S.TgName (covarDisplayName v) id
                 case inferScope state' ^. T.names . at var of
                   Just ty -> pure (Just (pretty v <+> colon <+> nest 2 (displayType ty <+> equals </> hsep (map pretty repr))))
                   Nothing -> pure Nothing

src/Backend/Escape.hs

@@ -63,7 +63,7 @@ pushVar v s = escapeVar (toVar v) where
   escapeVar v@(CoVar _ name _) =
     case Map.lookup v (toEsc s) of
       Just n -> (n, s)
-      Nothing -> pushFirst Nothing (escape s name)
+      Nothing -> pushFirst Nothing (escape s (fromMaybe "tmp" name))
 
   pushFirst :: Maybe Int -> T.Text -> (T.Text, EscapeScope)
   pushFirst prefix esc =

src/Backend/Lua/Builtin.hs

@@ -8,8 +8,6 @@ module Backend.Lua.Builtin
   , builtinBuilders
   ) where
 
-import Control.Lens
-
 import qualified Data.VarMap as VarMap
 import qualified Data.Sequence as Seq
 import qualified Data.Text as T
@@ -184,7 +182,7 @@ builtins =
 
   where
     genOp (var, op) =
-      let name = escaper (var ^. covarName)
+      let name = escaper (covarDisplayName var)
           name_ = LuaName name
           inner = LuaBinOp (LuaRef left) op (LuaRef right)
       in ( var, name, []

src/Backend/Lua/Emit.hs

@@ -168,7 +168,7 @@ toGraph = Graph DirectedGraph
 
 instance IsVar a => Pretty (VarMap.Map (EmittedNode a)) where
   pretty = drawGraph disp . toGraph where
-    disp (CoVar id name _) = text name <> "_" <> int' id
+    disp v@(CoVar id _ _) = text (covarDisplayName v) <> "_" <> int' id
     int' x | x < 0 = "_" <> int (-x)
            | otherwise = int x
 

src/Control/Monad/Infer.hs

@@ -17,7 +17,7 @@ module Control.Monad.Infer
   , Constraint(..)
   , Env
   , MonadInfer, Name
-  , lookupTy, lookupTy', genNameFrom, genNameWith, runInfer, freeInEnv
+  , lookupTy, lookupTy', runInfer, freeInEnv
   , difference, freshTV, refreshTV
   , instantiate
   , SomeReason(..), Reasonable, addBlame
@@ -220,16 +220,6 @@ runInfer :: MonadNamey m
 runInfer ct ac = over here toList <$>
   runChronicleT (runWriterT (runReaderT ac ct))
 
-genNameFrom :: MonadNamey m => Text -> m (Var Desugared)
-genNameFrom t = do
-  ~(TgName _ n) <- genName
-  pure (TgName t n)
-
-genNameWith :: MonadNamey m => Text -> m (Var Desugared)
-genNameWith t = do
-  ~(TgName e n) <- genName
-  pure (TgName (t <> e) n)
-
 firstName :: Var Desugared
 firstName = TgName "a" 0
 

src/Control/Monad/Namey.hs

@@ -14,6 +14,7 @@ module Control.Monad.Namey
   ( NameyT, runNameyT, evalNameyT
   , Namey, runNamey, evalNamey
   , MonadNamey(..)
+  , genNameFrom, genNameWith
   , genAlnum
   ) where
 
@@ -150,3 +151,15 @@ genAlnum n = go (fromIntegral n) T.empty (floor (logBase 26 (fromIntegral n :: D
               0 -> 1
               x -> x
      in go (n `mod'` (26 ^ p)) (T.snoc out (chr (96 + m))) (p - 1)
+
+-- | Generate a fresh var with a specific name.
+genNameFrom :: MonadNamey m => T.Text -> m (Var Desugared)
+genNameFrom t = do
+  ~(TgName _ n) <- genName
+  pure (TgName t n)
+
+-- | Generate a fresh var prepended with another name.
+genNameWith :: MonadNamey m => T.Text -> m (Var Desugared)
+genNameWith t = do
+  ~(TgName e n) <- genName
+  pure (TgName (t <> e) n)

src/Core/Builtin.hs

@@ -283,4 +283,4 @@ fakeKINT =
 
 makeBuiltins :: [ (Text, VarInfo) ] -> [CoVar]
 makeBuiltins xs = zipWith go xs [-1, -2 ..] where
-  go (name, t) id = CoVar id name t
+  go (name, t) id = CoVar id (Just name) t

src/Core/Lint.hs

@@ -465,7 +465,7 @@ checkNoUnboxed ValuesTy{} = pushError IllegalUnbox
 checkNoUnboxed _ = pure ()
 
 unknownVar :: IsVar a => a
-unknownVar = fromVar (CoVar (-100) "?" ValueVar)
+unknownVar = fromVar (CoVar (-100) (Just "?") ValueVar)
 
 unknownTyvar :: IsVar a => Type a
 unknownTyvar = VarTy unknownVar

src/Core/Lower.hs

@@ -188,7 +188,7 @@ lowerAt (ExprWrapper wrap e an) ty =
     S.TypeLam (Skolem (TgName _ id) (TgName n _) _ _) k ->
       let ty' (ForallTy (Relevant v) _ t) = substituteInType (VarMap.singleton v (VarTy var)) t
           ty' x = x
-          var = CoVar id n TypeVar
+          var = CoVar id (Just n) TypeVar
        in Lam (TypeArgument var (lowerType k)) <$> lowerAtTerm e (ty' ty)
     S.TypeLam _ _ -> error "impossible lowerAt TypeLam"
     ws S.:> wy -> lowerAt (ExprWrapper ws (ExprWrapper wy e an) an) ty
@@ -414,8 +414,8 @@ lowerLet bs =
       patternExtract pos p test ty outerTy (var, (_, innerTy)) = do
         let var' = mkVal var
             innerTy' = lowerType innerTy
-        pvar@(CoVar vn vt _) <- freshFrom var'
-        let p' = stripPtrn var (TgName vt vn) p
+        pvar@(CoVar vn _ _) <- freshFrom var'
+        let p' = stripPtrn var (TgName (covarDisplayName pvar) vn) p
 
         -- Generate `let x = match test with | ... x' ... -> x`
         One  . (var', outerTy, ) <$> patternWrap pos p' test ty outerTy (Atom (Ref pvar innerTy')) innerTy'

src/Core/Lower/Basic.hs

@@ -48,7 +48,7 @@ mkCon = mkVar DataConVar
 
 -- | Make a core variable from a "Syntax" variable and a given kind.
 mkVar :: VarInfo -> Var Resolved -> CoVar
-mkVar k (TgName t i) = CoVar i t k
+mkVar k (TgName n i) = CoVar i (Just n) k
 mkVar _ n@TgInternal{} = error ("Cannot convert " ++ show n ++ " to CoVar")
 
 -- | Lower a type from "Syntax" to one in "Core.Core".
@@ -77,7 +77,7 @@ lowerType (S.TyCon v)
   | v == Bi.tyConstraintName = StarTy
   | otherwise = ConTy (mkType v)
 lowerType (S.TyPromotedCon v) = ConTy (mkCon v) -- TODO this is in the wrong scope
-lowerType (S.TySkol (Skolem (TgName _ v) (TgName n _) _ _)) = VarTy (CoVar v n TypeVar)
+lowerType (S.TySkol (Skolem (TgName _ v) (TgName n _) _ _)) = VarTy (CoVar v (Just n) TypeVar)
 lowerType (S.TySkol _) = error "impossible lowerType TySkol"
 lowerType (S.TyOperator l o r)
   | o == Bi.tyTupleName = lowerType (S.TyTuple l r)