Keep type info in HideType to support non-primitive types

3 files changed, 9 insertions, 8 deletions

diff --git a/src/Parser/Core.hs b/src/Parser/Core.hs
index 4c49ead..e1a4035 100644
--- a/src/Parser/Core.hs
+++ b/src/Parser/Core.hs
@@ -219,7 +219,8 @@ unifyExpr off pa expr = if
         _ <- unify off (ExprTypePrim (Proxy :: Proxy a)) stype
         return $ Variable sline name
 
-    | HideType expr' <- expr
+    | HideType (ExprTypePrim (_ :: Proxy b'')) (expr' :: Expr b') <- expr
+    , Just (Refl :: b'' :~: b') <- eqT
     -> do
         unifyExpr off pa expr'
 
diff --git a/src/Parser/Expr.hs b/src/Parser/Expr.hs
index 8d1fe03..3716c80 100644
--- a/src/Parser/Expr.hs
+++ b/src/Parser/Expr.hs
@@ -194,7 +194,7 @@ list = label "list" $ do
             return $ SomeExpr $
                 TypeLambda tvar (ExprTypeApp (ExprTypeConstr1 (Proxy :: Proxy [])) [ ExprTypeVar tvar ]) $
                     \case
-                        (ExprTypePrim (Proxy :: Proxy a)) -> HideType $ Pure ([] :: [ a ])
+                        (ExprTypePrim (Proxy :: Proxy a)) -> HideType (ExprTypePrim (Proxy @[ a ])) $ Pure ([] :: [ a ])
                         _ -> Undefined "incomplete type"
 
         ,do SomeExpr x <- someExpr
diff --git a/src/Script/Expr.hs b/src/Script/Expr.hs
index bbb6083..a975ef5 100644
--- a/src/Script/Expr.hs
+++ b/src/Script/Expr.hs
@@ -63,7 +63,7 @@ data Expr a where
     ArgsApp :: ExprType a => FunctionArguments SomeExpr -> Expr (FunctionType a) -> Expr (FunctionType a)
     FunctionAbstraction :: ExprType a => Expr a -> Expr (FunctionType a)
     FunctionEval :: ExprType a => SourceLine -> Expr (FunctionType a) -> Expr a
-    HideType :: forall a. ExprType a => Expr a -> Expr DynamicType
+    HideType :: forall a. Typeable a => SomeExprType -> Expr a -> Expr DynamicType
     TypeLambda :: TypeVar -> SomeExprType -> (SomeExprType -> Expr DynamicType) -> Expr DynamicType
     TypeApp :: forall a. ExprType a => Expr DynamicType -> SomeExprType -> Expr a
     LambdaAbstraction :: ExprType a => TypedVarName a -> Expr b -> Expr (a -> b)
@@ -107,7 +107,7 @@ mapExpr f = go
         ArgsApp args expr -> f $ ArgsApp (fmap (\(SomeExpr e) -> SomeExpr (go e)) args) (go expr)
         FunctionAbstraction expr -> f $ FunctionAbstraction (go expr)
         FunctionEval sline expr -> f $ FunctionEval sline (go expr)
-        HideType expr -> HideType $ go expr
+        HideType stype expr -> HideType stype $ go expr
         TypeLambda tvar stype efun -> TypeLambda tvar stype (go . efun)
         TypeApp expr stype -> TypeApp (go expr) stype
         LambdaAbstraction tvar expr -> f $ LambdaAbstraction tvar (go expr)
@@ -204,7 +204,7 @@ eval = \case
         let cs' = CallStack (( sline, vars ) : cs)
         FunctionType fun <- withVar callStackVarName cs' $ eval efun
         return $ fun cs' mempty
-    HideType expr -> DynamicType <$> eval expr
+    HideType _ expr -> DynamicType <$> eval expr
     TypeLambda _ _ f -> do
         gdefs <- askGlobalDefs
         dict <- askDictionary
@@ -296,7 +296,7 @@ someExprType (SomeExpr expr) = go expr
     go :: forall e. ExprType e => Expr e -> SomeExprType
     go = \case
         DynVariable stype _ _ -> stype
-        HideType e -> go e
+        HideType stype _ -> stype
         TypeLambda tvar stype _ -> ExprTypeForall tvar stype
 
         ArgsReq args inner -> exprTypeFunction (fmap snd args) (go inner)
@@ -328,7 +328,7 @@ renameTypeVar a b = go
         ArgsApp args fun -> ArgsApp (fmap (renameTypeVarInSomeExpr a b) args) (go fun)
         FunctionAbstraction expr -> FunctionAbstraction (go expr)
         FunctionEval sline expr -> FunctionEval sline (go expr)
-        HideType expr -> HideType (go expr)
+        HideType stype expr -> HideType (renameVarInType a b stype) (go expr)
         TypeLambda tvar stype expr
             | tvar == a -> orig
             | tvar == b -> error "type var collision"
@@ -493,7 +493,7 @@ gatherVars = fmap (uniqOn fst . sortOn fst) . helper
             return $ concat (v : vs)
         FunctionAbstraction expr -> helper expr
         FunctionEval _ efun -> helper efun
-        HideType expr -> helper expr
+        HideType _ expr -> helper expr
         TypeLambda {} -> return []
         TypeApp expr _ -> helper expr
         LambdaAbstraction (TypedVarName var) expr -> withDictionary (filter ((var /=) . fst)) $ helper expr