diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2026-04-19 10:54:59 +0200 |
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2026-04-19 11:04:52 +0200 |
| commit | 9a8b6b9202f2eb7a8f51ed04ceaf29d2a358f682 (patch) | |
| tree | d8d1ebfb323c3303dfa44279a4da21b0e01d7ffb /src | |
| parent | db5d73811c42d640f606ede40f861e1c052f8ca5 (diff) | |
Keep type information for polymorphic variables
Diffstat (limited to 'src')
| -rw-r--r-- | src/Parser/Expr.hs | 9 | ||||
| -rw-r--r-- | src/Parser/Statement.hs | 4 |
2 files changed, 8 insertions, 5 deletions
diff --git a/src/Parser/Expr.hs b/src/Parser/Expr.hs index c57aa97..53bd1a1 100644 --- a/src/Parser/Expr.hs +++ b/src/Parser/Expr.hs @@ -4,7 +4,7 @@ module Parser.Expr ( varName, newVarName, - addVarName, + addVarName, addVarNameType, constrName, someExpr, @@ -78,12 +78,15 @@ newVarName = do return name addVarName :: forall a. ExprType a => Int -> TypedVarName a -> TestParser () -addVarName off (TypedVarName name) = do +addVarName off tname = addVarNameType off tname (ExprTypePrim @a Proxy) + +addVarNameType :: forall a. ExprType a => Int -> TypedVarName a -> SomeExprType -> TestParser () +addVarNameType off (TypedVarName name) stype = do gets (lookup name . testVars) >>= \case Just _ -> registerParseError $ FancyError off $ S.singleton $ ErrorFail $ T.unpack $ T.pack "variable '" <> textVarName name <> T.pack "' already exists" Nothing -> return () - modify $ \s -> s { testVars = ( name, ( LocalVarName name, ExprTypePrim @a Proxy )) : testVars s } + modify $ \s -> s { testVars = ( name, ( LocalVarName name, stype )) : testVars s } constrName :: TestParser VarName constrName = label "contructor name" $ do diff --git a/src/Parser/Statement.hs b/src/Parser/Statement.hs index 4548b63..96af2f3 100644 --- a/src/Parser/Statement.hs +++ b/src/Parser/Statement.hs @@ -37,11 +37,11 @@ letStatement = do off <- stateOffset <$> getParserState name <- varName osymbol "=" - SomeExpr e <- someExpr + se@(SomeExpr e) <- someExpr localState $ do let tname = TypedVarName name - addVarName off tname + addVarNameType off tname (someExprType se) void $ eol body <- testBlock indent return $ Let line tname e (TestBlockStep EmptyTestBlock . Scope <$> body) |