diff options
| author | Tom Smeding <tom@tomsmeding.com> | 2024-03-23 18:55:10 +0100 |
|---|---|---|
| committer | Tom Smeding <tom@tomsmeding.com> | 2024-03-23 18:55:10 +0100 |
| commit | 071a55031cbfadf8e71d21b13c19ff80c2ab96e3 (patch) | |
| tree | 3bb5e46aa5ae3c7553aec2202b80ebf90fc0608a /src/HSVIS/AST.hs | |
| parent | 909b7a4eacaba7323ac44f7950e60e8956e4081c (diff) | |
typechecker work
Diffstat (limited to 'src/HSVIS/AST.hs')
| -rw-r--r-- | src/HSVIS/AST.hs | 16 |
1 files changed, 16 insertions, 0 deletions
diff --git a/src/HSVIS/AST.hs b/src/HSVIS/AST.hs index 2b125b9..e25657b 100644 --- a/src/HSVIS/AST.hs +++ b/src/HSVIS/AST.hs @@ -95,6 +95,7 @@ data Type s | TFun (X Type s) (Type s) (Type s) | TCon (X Type s) Name | TVar (X Type s) Name + | TForall (X Type s) Name (Type s) -- ^ implicit -- extension point | TExt (X Type s) !(E Type s) @@ -156,6 +157,8 @@ instance Pretty (E Type s) => Pretty (Type s) where prettysPrec 0 a . showString " -> " . prettysPrec (-1) b prettysPrec _ (TCon _ n) = prettysPrec 11 n prettysPrec _ (TVar _ n) = prettysPrec 11 n + prettysPrec d (TForall _ n t) = showParen (d > -1) $ + showString "forall " . prettysPrec 11 n . showString "." . prettysPrec (-1) t prettysPrec d (TExt _ e) = prettysPrec d e instance (Pretty (X Type s), Pretty (E Type s)) => Pretty (DataDef s) where @@ -168,6 +171,17 @@ instance (Pretty (X Type s), Pretty (E Type s)) => Pretty (DataDef s) where [prettysPrec 11 cname . foldr (.) id [showString " " . prettysPrec 11 t | t <- fields] | (cname, fields) <- cons]) +instance Pretty Operator where + prettysPrec _ = showString . \case + OAdd -> "(+)" + OSub -> "(-)" + OMul -> "(*)" + ODiv -> "(/)" + OMod -> "(%)" + OEqu -> "(==)" + OPow -> "(^)" + OCons -> "(:)" + instance HasExt DataDef where type HasXField DataDef = 'True type HasECon DataDef = 'False @@ -225,6 +239,7 @@ instance HasExt Type where extOf (TFun x _ _) = x extOf (TCon x _) = x extOf (TVar x _) = x + extOf (TForall x _ _) = x extOf (TExt x _) = x extMap p ps1 ps2 f g (TApp x a b) = TApp (f x) (extMap p ps1 ps2 f g a) (map (extMap p ps1 ps2 f g) b) @@ -233,6 +248,7 @@ instance HasExt Type where extMap p ps1 ps2 f g (TFun x a b) = TFun (f x) (extMap p ps1 ps2 f g a) (extMap p ps1 ps2 f g b) extMap _ _ _ f _ (TCon x n) = TCon (f x) n extMap _ _ _ f _ (TVar x n) = TVar (f x) n + extMap p ps1 ps2 f g (TForall x n a) = TForall (f x) n (extMap p ps1 ps2 f g a) extMap _ _ _ _ g (TExt x e) = g x e instance HasExt Pattern where |