diff options
author | Roman Smrž <roman.smrz@seznam.cz> | 2025-02-24 22:08:35 +0100 |
---|---|---|
committer | Roman Smrž <roman.smrz@seznam.cz> | 2025-02-24 22:08:35 +0100 |
commit | aa161777510728c94e51e9ef1d6df4146d7d952b (patch) | |
tree | 9f541ee6e2bd39c31ac55f9096b40a66e349a8af | |
parent | 3640256e80ba1aa1c1e022a231234dee814ace58 (diff) |
Scalar unification for variables in expansion
-rw-r--r-- | src/Parser/Core.hs | 9 | ||||
-rw-r--r-- | src/Parser/Expr.hs | 2 |
2 files changed, 10 insertions, 1 deletions
diff --git a/src/Parser/Core.hs b/src/Parser/Core.hs index a0ba229..5fb2139 100644 --- a/src/Parser/Core.hs +++ b/src/Parser/Core.hs @@ -97,6 +97,15 @@ lookupVarExpr off sline name = do ExprTypeVar tvar -> return $ SomeExpr $ DynVariable tvar sline fqn ExprTypeFunction args (_ :: Proxy a) -> return $ SomeExpr $ (FunVariable args sline fqn :: Expr (FunctionType a)) +lookupScalarVarExpr :: Int -> SourceLine -> VarName -> TestParser SomeExpr +lookupScalarVarExpr off sline name = do + ( fqn, etype ) <- lookupVarType off name + case etype of + ExprTypePrim (Proxy :: Proxy a) -> return $ SomeExpr $ (Variable sline fqn :: Expr a) + 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)) + unify :: Int -> SomeExprType -> SomeExprType -> TestParser SomeExprType unify _ (ExprTypeVar aname) (ExprTypeVar bname) | aname == bname = do cur <- gets testTypeUnif diff --git a/src/Parser/Expr.hs b/src/Parser/Expr.hs index bc16149..9966d6f 100644 --- a/src/Parser/Expr.hs +++ b/src/Parser/Expr.hs @@ -89,7 +89,7 @@ someExpansion = do [do off <- stateOffset <$> getParserState sline <- getSourceLine name <- VarName . TL.toStrict <$> takeWhile1P Nothing (\x -> isAlphaNum x || x == '_') - lookupVarExpr off sline name + lookupScalarVarExpr off sline name , between (char '{') (char '}') someExpr ] |