From a84c4722a3774bb64e3e3616c16264d09c991378 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Sat, 25 Apr 2026 13:10:13 +0200 Subject: Keep type info in HideType to support non-primitive types --- src/Parser/Core.hs | 3 ++- src/Parser/Expr.hs | 2 +- src/Script/Expr.hs | 12 ++++++------ 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 -- cgit v1.2.3