diff --git a/docs/LanguageGuide.md b/docs/LanguageGuide.md index 329e26f6..590d8246 100644 --- a/docs/LanguageGuide.md +++ b/docs/LanguageGuide.md @@ -237,6 +237,8 @@ Note that match works with *values* (not references) takes ownership over the va Note that this code would not take ownership over `might-be-a-string`. Also, the `s` in the first case is a reference, since it wouldn't be safe to destructure the `Maybe` into values in this situation. +**Note:** A sumtype cannot have more than 128 inhabitants, also known as constructors. If that reads to you like a byte limitation, you’re on the right track. While this is a limitation, it has not proved to be a problem as of yet. + ### Modules and Name Lookup Functions and variables can be stored in modules which are named and can be nested. To use a symbol inside a module you need to qualify it with the module name, like this: `Float.cos`. diff --git a/src/PrimitiveError.hs b/src/PrimitiveError.hs index 4c992d78..96205044 100644 --- a/src/PrimitiveError.hs +++ b/src/PrimitiveError.hs @@ -19,6 +19,7 @@ data PrimitiveError | StructNotFound XObj | NonTypeInTypeEnv SymPath XObj | InvalidSumtypeCase XObj + | TooManySumtypeCases data PrimitiveWarning = NonExistentInterfaceWarning XObj @@ -74,6 +75,8 @@ instance Show PrimitiveError where show (PrimitiveError.InvalidSumtypeCase xobj) = "Can't get members for an invalid sumtype case: " ++ pretty xobj + show TooManySumtypeCases = + "Got too many sumtype cases (>128) for type" instance Show PrimitiveWarning where show (NonExistentInterfaceWarning x) = diff --git a/src/Primitives.hs b/src/Primitives.hs index 675ed3af..4e914984 100644 --- a/src/Primitives.hs +++ b/src/Primitives.hs @@ -413,7 +413,7 @@ primitiveMembers _ ctx xobj@(XObj (Sym path _) _ _) = go (XObj (Lst [(XObj (Deftype _) _ _), _, (XObj (Arr members) _ _)]) _ _) = pure (ctx, Right (XObj (Arr (map (\(a, b) -> XObj (Lst [a, b]) Nothing Nothing) (pairwise members))) Nothing Nothing)) go (XObj (Lst ((XObj (DefSumtype _) _ _) : _ : cases)) _ _) = - pure $ (ctx, (either Left (\a -> Right (XObj (Arr (concat a)) Nothing Nothing)) (mapM getMembersFromCase cases))) + pure (ctx, (either Left (\a -> Right (XObj (Arr (concat a)) Nothing Nothing)) (mapM getMembersFromCase cases))) go x = pure (toEvalError ctx x (NonTypeInTypeEnv path x)) getMembersFromCase :: XObj -> Either EvalError [XObj] getMembersFromCase (XObj (Lst members) _ _) = @@ -576,8 +576,10 @@ primitiveDeftype xobj ctx (name : rest@(XObj (Arr a) _ _ : _)) = if all isUnqualifiedSym objs then deftype ctx name (selectConstructor rest) else pure (toEvalError ctx xobj (QualifiedTypeMember rest)) -primitiveDeftype _ ctx (name : rest) = - deftype ctx name (selectConstructor rest) +primitiveDeftype x ctx (name : rest) = + if length rest > 128 + then pure (toEvalError ctx x TooManySumtypeCases) + else deftype ctx name (selectConstructor rest) primitiveDeftype _ _ _ = error "primitivedeftype" type ModuleCreator = Context -> String -> [Ty] -> [XObj] -> Maybe Info -> Either TypeError (String, XObj, [XObj])