diff options
Diffstat (limited to 'Sil/Types.icl')
| -rw-r--r-- | Sil/Types.icl | 21 |
1 files changed, 8 insertions, 13 deletions
diff --git a/Sil/Types.icl b/Sil/Types.icl index b2009dd..e314342 100644 --- a/Sil/Types.icl +++ b/Sil/Types.icl @@ -19,6 +19,7 @@ from Text import <+ from ABC.Assembler import :: BasicType(..) +import Sil.Error import Sil.Syntax import Sil.Util.Printer @@ -33,12 +34,6 @@ where toString (at --> rt) = "(" <+ at <+ " -> " <+ rt <+ ")" toString (TTuple _ ts) = "(" <+ printersperse ", " ts <+ ")" -instance toString TypeError -where - toString (IllegalApplication ft et) = "Cannot apply a " <+ et <+ " to a " <+ ft <+ "." - toString (IllegalField f t) = "Illegal field '" <+ f <+ "' on type " <+ t <+ "." - toString (TooHighTupleArity i) = "Too high tuple arity " <+ i <+ " (maximum is 32)." - instance zero TypeSize where zero = {asize=0, bsize=0, btypes=[]} typeSize :: Type -> TypeSize @@ -91,27 +86,27 @@ where te1 >>= \te1 -> te2 >>= \te2 -> foldM tryApply top [te1,te2]) type res (Tuple n es) - | n > 32 = Just $ Error $ TooHighTupleArity n + | n > 32 = Just $ Error $ T_TooHighTupleArity n | otherwise = mapM (type res) es >>= \ats -> pure (sequence ats >>= pure o TTuple n) type res (Field f e) | isTuple = type res e >>= \te -> pure (te >>= \te -> case te of TTuple arity es -> if (0 < tupleEl && tupleEl <= arity) (Ok $ es!!(tupleEl - 1)) - (Error $ IllegalField f te) - _ -> Error $ IllegalField f te) - | otherwise = type res e >>= \te -> pure (te >>= Error o IllegalField f) + (Error $ T_IllegalField f te) + _ -> Error $ T_IllegalField f te) + | otherwise = type res e >>= \te -> pure (te >>= Error o T_IllegalField f) where f` = fromString f isTuple = length f` >= 2 && hd f` == '_' && all isDigit (tl f`) tupleEl = toInt $ toString $ tl f` -tryApply :: Type Type -> MaybeError TypeError Type +tryApply :: Type Type -> MaybeError Error Type tryApply ft=:(at --> rt) et | et == at = Ok rt -| otherwise = Error $ IllegalApplication ft et -tryApply ft et = Error $ IllegalApplication ft et +| otherwise = Error $ T_IllegalApplication ft et +tryApply ft et = Error $ T_IllegalApplication ft et instance type Name where type res n = res n |