diff options
Diffstat (limited to 'Sil/Types.icl')
| -rw-r--r-- | Sil/Types.icl | 27 |
1 files changed, 14 insertions, 13 deletions
diff --git a/Sil/Types.icl b/Sil/Types.icl index a68a7b8..2fdd666 100644 --- a/Sil/Types.icl +++ b/Sil/Types.icl @@ -21,6 +21,7 @@ from ABC.Assembler import :: BasicType(..) import Sil.Error import Sil.Syntax +import Sil.Util.Parser import Sil.Util.Printer derive gEq Type @@ -70,30 +71,30 @@ where type res (Literal _ lit) = case lit of BLit _ -> Just $ Ok TBool ILit _ -> Just $ Ok TInt - type res (App _ n args) = + type res (App p n args) = mapM (type res) args >>= \ats -> res n >>= \ft -> pure ( sequence ats >>= \ats -> - ft >>= \ft -> foldM tryApply ft ats) - type res (BuiltinApp _ op e) = + ft >>= \ft -> foldM (tryApply p) ft ats) + type res (BuiltinApp p op e) = type res e >>= \te -> type res op >>= \top -> pure ( top >>= \top -> - te >>= \te -> tryApply top te) - type res (BuiltinApp2 _ e1 Cons e2) = + te >>= \te -> tryApply p top te) + type res (BuiltinApp2 p e1 Cons e2) = type res e1 >>= \te1 -> type res e2 >>= \te2 -> pure ( te1 >>= \te1 -> te2 >>= \te2 -> let top = te1 --> TList te1 --> TList te1 in - foldM tryApply top [te1,te2]) - type res (BuiltinApp2 _ e1 op e2) = + foldM (tryApply p) top [te1,te2]) + type res (BuiltinApp2 p e1 op e2) = type res e1 >>= \te1 -> type res e2 >>= \te2 -> type res op >>= \top -> pure ( top >>= \top -> te1 >>= \te1 -> - te2 >>= \te2 -> foldM tryApply top [te1,te2]) + te2 >>= \te2 -> foldM (tryApply p) top [te1,te2]) type res e=:(List _ (Just t) es) = mapM (type res) es >>= \tes -> pure (sequence tes >>= \tes -> case [(e,t`) \\ e <- es & t` <- tes | t <> t`] of @@ -131,11 +132,11 @@ where isTuple = length f` >= 2 && hd f` == '_' && all isDigit (tl f`) tupleEl = toInt $ toString $ tl f` -tryApply :: Type Type -> MaybeError Error Type -tryApply ft=:(at --> rt) et -| et == at = Ok rt -| otherwise = Error $ T_IllegalApplication ft et -tryApply ft et = Error $ T_IllegalApplication ft et +tryApply :: ParsePosition Type Type -> MaybeError Error Type +tryApply p ft=:(at --> rt) et +| et == at = Ok rt +| otherwise = Error $ T_IllegalApplication (errpos p) ft et +tryApply p ft et = Error $ T_IllegalApplication (errpos p) ft et instance type Name where type res n = res n |