diff options
Diffstat (limited to 'Sil/Types.icl')
| -rw-r--r-- | Sil/Types.icl | 29 |
1 files changed, 29 insertions, 0 deletions
diff --git a/Sil/Types.icl b/Sil/Types.icl index e314342..ba13cba 100644 --- a/Sil/Types.icl +++ b/Sil/Types.icl @@ -33,6 +33,7 @@ where toString TVoid = "Void" toString (at --> rt) = "(" <+ at <+ " -> " <+ rt <+ ")" toString (TTuple _ ts) = "(" <+ printersperse ", " ts <+ ")" + toString (TList t) = "[" <+ t <+ "]" instance zero TypeSize where zero = {asize=0, bsize=0, btypes=[]} @@ -41,6 +42,7 @@ typeSize TVoid = zero typeSize TBool = {zero & bsize=1, btypes=[BT_Bool]} typeSize TInt = {zero & bsize=1, btypes=[BT_Int]} typeSize (TTuple _ _) = {zero & asize=1} +typeSize (TList _) = {zero & asize=1} (+~) infixl 6 :: TypeSize TypeSize -> TypeSize (+~) a b = @@ -78,6 +80,13 @@ where type res op >>= \top -> pure ( top >>= \top -> te >>= \te -> tryApply top te) + type res (BuiltinApp2 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) = type res e1 >>= \te1 -> type res e2 >>= \te2 -> @@ -85,6 +94,17 @@ where ( top >>= \top -> te1 >>= \te1 -> te2 >>= \te2 -> foldM tryApply 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 + [(e`,t`):_] -> Error $ C_TypeMisMatch t e` t` + [] -> Ok $ TList t) + type res (List Nothing []) = Nothing + type res e=:(List Nothing es) = + mapM (type res) es >>= \tes -> pure + (sequence tes >>= \tes -> case removeDup tes of + [t] -> Ok $ TList t + [_:_] -> Error $ C_CouldNotDeduceType e) type res (Tuple n es) | n > 32 = Just $ Error $ T_TooHighTupleArity n | otherwise = @@ -95,6 +115,15 @@ where (Ok $ es!!(tupleEl - 1)) (Error $ T_IllegalField f te) _ -> Error $ T_IllegalField f te) + | f == "hd" = type res e >>= \te -> pure (te >>= \te -> case te of + TList t -> Ok t + _ -> Error $ T_IllegalField f te) + | f == "tl" = type res e >>= \te -> pure (te >>= \te -> case te of + t=:(TList _) -> Ok t + _ -> Error $ T_IllegalField f te) + | f == "nil" = type res e >>= \te -> pure (te >>= \te -> case te of + (TList _) -> Ok TBool + _ -> Error $ T_IllegalField f te) | otherwise = type res e >>= \te -> pure (te >>= Error o T_IllegalField f) where f` = fromString f |