From 3a6faf446c2e62add01c5d912a533f20e853ac77 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Sun, 12 Apr 2026 11:39:29 +0200 Subject: Type constructors --- src/Parser.hs | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) (limited to 'src/Parser.hs') diff --git a/src/Parser.hs b/src/Parser.hs index bb8288e..e38f1ef 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -102,10 +102,18 @@ parseDefinition href = label "symbol definition" $ do let err msg = do registerParseError . FancyError off . S.singleton . ErrorFail $ T.unpack msg return ( vname, SomeArgumentType (OptionalArgument @DynamicType) ) + let getConcreteType = \case + (ExprTypeApp (ExprTypeConstr1 (Proxy :: Proxy a)) [ pb ]) + | ExprTypePrim (_ :: Proxy b) <- getConcreteType pb + -> ExprTypePrim (Proxy :: Proxy (a b)) + t -> t gets (M.lookup tvar . testTypeUnif) >>= \case - Just (ExprTypePrim (_ :: Proxy a)) -> return ( vname, SomeArgumentType (RequiredArgument @a) ) - Just (ExprTypeVar (TypeVar tvar')) -> err $ "ambiguous type for ‘" <> textVarName vname <> " : " <> tvar' <> "’" - Just (ExprTypeFunction {}) -> err $ "unsupported function type of ‘" <> textVarName vname <> "’" + Just t + | ExprTypePrim (_ :: Proxy a) <- getConcreteType t + -> return ( vname, SomeArgumentType (RequiredArgument @a) ) + + | otherwise + -> err $ "expected concrete type for ‘" <> textVarName vname <> " : " <> textSomeExprType t <> "’" Nothing -> err $ "ambiguous type for ‘" <> textVarName vname <> " : " <> tvarname <> "’" replaceDynArgs :: forall a. Expr a -> TestParser (Expr a) -- cgit v1.2.3