diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Parser.hs | 2 | ||||
| -rw-r--r-- | src/Parser/Core.hs | 16 | ||||
| -rw-r--r-- | src/Script/Expr.hs | 8 |
3 files changed, 8 insertions, 18 deletions
diff --git a/src/Parser.hs b/src/Parser.hs index e38f1ef..c83d781 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -125,7 +125,7 @@ parseDefinition href = label "symbol definition" $ do go unif = \case ArgsApp args body -> ArgsApp (fmap replaceArgs args) body where - replaceArgs (SomeExpr (DynVariable tvar sline vname)) + replaceArgs (SomeExpr (DynVariable (ExprTypeVar tvar) sline vname)) | Just (ExprTypePrim (Proxy :: Proxy v)) <- M.lookup tvar unif = SomeExpr (Variable sline vname :: Expr v) replaceArgs (SomeExpr e) = SomeExpr (go unif e) diff --git a/src/Parser/Core.hs b/src/Parser/Core.hs index cd4031a..1b049c8 100644 --- a/src/Parser/Core.hs +++ b/src/Parser/Core.hs @@ -106,12 +106,8 @@ lookupVarExpr off sline name = do case etype of ExprTypePrim (Proxy :: Proxy a) -> return $ SomeExpr $ (Variable sline fqn :: Expr a) ExprTypeConstr1 _ -> return $ SomeExpr $ (Undefined "incomplete type" :: Expr DynamicType) - ExprTypeVar tvar -> return $ SomeExpr $ DynVariable tvar sline fqn ExprTypeFunction args (_ :: Proxy a) -> return $ SomeExpr $ (FunVariable args sline fqn :: Expr (FunctionType a)) - stype -> do - tvar <- newTypeVar - modify $ \s -> s { testTypeUnif = M.insert tvar stype $ testTypeUnif s } - return $ SomeExpr $ DynVariable tvar sline fqn + stype -> return $ SomeExpr $ DynVariable stype sline fqn lookupScalarVarExpr :: Int -> SourceLine -> VarName -> TestParser SomeExpr lookupScalarVarExpr off sline name = do @@ -119,13 +115,9 @@ lookupScalarVarExpr off sline name = do case etype of ExprTypePrim (Proxy :: Proxy a) -> return $ SomeExpr $ (Variable sline fqn :: Expr a) ExprTypeConstr1 _ -> return $ SomeExpr $ (Undefined "incomplete type" :: Expr DynamicType) - 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)) - stype -> do - tvar <- newTypeVar - modify $ \s -> s { testTypeUnif = M.insert tvar stype $ testTypeUnif s } - return $ SomeExpr $ DynVariable tvar sline fqn + stype -> return $ SomeExpr $ DynVariable stype sline fqn unify :: Int -> SomeExprType -> SomeExprType -> TestParser SomeExprType unify _ (ExprTypeVar aname) (ExprTypeVar bname) | aname == bname = do @@ -214,9 +206,9 @@ unifyExpr off pa expr = if | Just (Refl :: a :~: b) <- eqT -> return expr - | DynVariable tvar sline name <- expr + | DynVariable stype sline name <- expr -> do - _ <- unify off (ExprTypePrim (Proxy :: Proxy a)) (ExprTypeVar tvar) + _ <- unify off (ExprTypePrim (Proxy :: Proxy a)) stype return $ Variable sline name | HideType expr' <- expr diff --git a/src/Script/Expr.hs b/src/Script/Expr.hs index de66412..0941ffa 100644 --- a/src/Script/Expr.hs +++ b/src/Script/Expr.hs @@ -56,7 +56,7 @@ import Util data Expr a where Let :: forall a b. ExprType b => SourceLine -> TypedVarName b -> Expr b -> Expr a -> Expr a Variable :: ExprType a => SourceLine -> FqVarName -> Expr a - DynVariable :: TypeVar -> SourceLine -> FqVarName -> Expr DynamicType + DynVariable :: SomeExprType -> SourceLine -> FqVarName -> Expr DynamicType FunVariable :: ExprType a => FunctionArguments SomeArgumentType -> SourceLine -> FqVarName -> Expr (FunctionType a) ArgsReq :: ExprType a => FunctionArguments ( VarName, SomeArgumentType ) -> Expr (FunctionType a) -> Expr (FunctionType a) ArgsApp :: ExprType a => FunctionArguments SomeExpr -> Expr (FunctionType a) -> Expr (FunctionType a) @@ -274,7 +274,7 @@ someExprType (SomeExpr expr) = go expr where go :: forall e. ExprType e => Expr e -> SomeExprType go = \case - DynVariable tvar _ _ -> ExprTypeVar tvar + DynVariable stype _ _ -> stype (e :: Expr a) | IsFunType <- asFunType e -> ExprTypeFunction (gof e) (proxyOfFunctionType e) | otherwise -> ExprTypePrim (Proxy @a) @@ -304,9 +304,7 @@ renameTypeVar a b = go go orig = case orig of Let sline vname x y -> Let sline vname (go x) (go y) Variable {} -> orig - DynVariable tvar sline name - | tvar == a -> DynVariable b sline name - | otherwise -> orig + DynVariable stype sline name -> DynVariable (renameVarInType a b stype) sline name FunVariable {} -> orig ArgsReq args body -> ArgsReq args (go body) ArgsApp args fun -> ArgsApp (fmap (renameTypeVarInSomeExpr a b) args) (go fun) |