Allow arbitrary types within DynVariableHEADmaster

3 files changed, 8 insertions, 18 deletions

diff --git a/src/Parser.hs b/src/Parser.hs
index e38f1ef..c83d781 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -125,7 +125,7 @@ parseDefinition href = label "symbol definition" $ do
         go unif = \case
             ArgsApp args body -> ArgsApp (fmap replaceArgs args) body
               where
-                replaceArgs (SomeExpr (DynVariable tvar sline vname))
+                replaceArgs (SomeExpr (DynVariable (ExprTypeVar tvar) sline vname))
                     | Just (ExprTypePrim (Proxy :: Proxy v)) <- M.lookup tvar unif
                     = SomeExpr (Variable sline vname :: Expr v)
                 replaceArgs (SomeExpr e) = SomeExpr (go unif e)
diff --git a/src/Parser/Core.hs b/src/Parser/Core.hs
index cd4031a..1b049c8 100644
--- a/src/Parser/Core.hs
+++ b/src/Parser/Core.hs
@@ -106,12 +106,8 @@ lookupVarExpr off sline name = do
     case etype of
         ExprTypePrim (Proxy :: Proxy a) -> return $ SomeExpr $ (Variable sline fqn :: Expr a)
         ExprTypeConstr1 _ -> return $ SomeExpr $ (Undefined "incomplete type" :: Expr DynamicType)
-        ExprTypeVar tvar -> return $ SomeExpr $ DynVariable tvar sline fqn
         ExprTypeFunction args (_ :: Proxy a) -> return $ SomeExpr $ (FunVariable args sline fqn :: Expr (FunctionType a))
-        stype -> do
-            tvar <- newTypeVar
-            modify $ \s -> s { testTypeUnif = M.insert tvar stype $ testTypeUnif s }
-            return $ SomeExpr $ DynVariable tvar sline fqn
+        stype -> return $ SomeExpr $ DynVariable stype sline fqn
 
 lookupScalarVarExpr :: Int -> SourceLine -> VarName -> TestParser SomeExpr
 lookupScalarVarExpr off sline name = do
@@ -119,13 +115,9 @@ lookupScalarVarExpr off sline name = do
     case etype of
         ExprTypePrim (Proxy :: Proxy a) -> return $ SomeExpr $ (Variable sline fqn :: Expr a)
         ExprTypeConstr1 _ -> return $ SomeExpr $ (Undefined "incomplete type" :: Expr DynamicType)
-        ExprTypeVar tvar -> return $ SomeExpr $ DynVariable tvar sline fqn
         ExprTypeFunction args (pa :: Proxy a) -> do
             SomeExpr <$> unifyExpr off pa (FunVariable args sline fqn :: Expr (FunctionType a))
-        stype -> do
-            tvar <- newTypeVar
-            modify $ \s -> s { testTypeUnif = M.insert tvar stype $ testTypeUnif s }
-            return $ SomeExpr $ DynVariable tvar sline fqn
+        stype -> return $ SomeExpr $ DynVariable stype sline fqn
 
 unify :: Int -> SomeExprType -> SomeExprType -> TestParser SomeExprType
 unify _ (ExprTypeVar aname) (ExprTypeVar bname) | aname == bname = do
@@ -214,9 +206,9 @@ unifyExpr off pa expr = if
     | Just (Refl :: a :~: b) <- eqT
     -> return expr
 
-    | DynVariable tvar sline name <- expr
+    | DynVariable stype sline name <- expr
     -> do
-        _ <- unify off (ExprTypePrim (Proxy :: Proxy a)) (ExprTypeVar tvar)
+        _ <- unify off (ExprTypePrim (Proxy :: Proxy a)) stype
         return $ Variable sline name
 
     | HideType expr' <- expr
diff --git a/src/Script/Expr.hs b/src/Script/Expr.hs
index de66412..0941ffa 100644
--- a/src/Script/Expr.hs
+++ b/src/Script/Expr.hs
@@ -56,7 +56,7 @@ import Util
 data Expr a where
     Let :: forall a b. ExprType b => SourceLine -> TypedVarName b -> Expr b -> Expr a -> Expr a
     Variable :: ExprType a => SourceLine -> FqVarName -> Expr a
-    DynVariable :: TypeVar -> SourceLine -> FqVarName -> Expr DynamicType
+    DynVariable :: SomeExprType -> SourceLine -> FqVarName -> Expr DynamicType
     FunVariable :: ExprType a => FunctionArguments SomeArgumentType -> SourceLine -> FqVarName -> Expr (FunctionType a)
     ArgsReq :: ExprType a => FunctionArguments ( VarName, SomeArgumentType ) -> Expr (FunctionType a) -> Expr (FunctionType a)
     ArgsApp :: ExprType a => FunctionArguments SomeExpr -> Expr (FunctionType a) -> Expr (FunctionType a)
@@ -274,7 +274,7 @@ someExprType (SomeExpr expr) = go expr
   where
     go :: forall e. ExprType e => Expr e -> SomeExprType
     go = \case
-        DynVariable tvar _ _ -> ExprTypeVar tvar
+        DynVariable stype _ _ -> stype
         (e :: Expr a)
             | IsFunType <- asFunType e -> ExprTypeFunction (gof e) (proxyOfFunctionType e)
             | otherwise -> ExprTypePrim (Proxy @a)
@@ -304,9 +304,7 @@ renameTypeVar a b = go
     go orig = case orig of
         Let sline vname x y -> Let sline vname (go x) (go y)
         Variable {} -> orig
-        DynVariable tvar sline name
-            | tvar == a -> DynVariable b sline name
-            | otherwise -> orig
+        DynVariable stype sline name -> DynVariable (renameVarInType a b stype) sline name
         FunVariable {} -> orig
         ArgsReq args body -> ArgsReq args (go body)
         ArgsApp args fun -> ArgsApp (fmap (renameTypeVarInSomeExpr a b) args) (go fun)