diff options
| author | Camil Staps | 2017-07-27 23:13:50 +0200 |
|---|---|---|
| committer | Camil Staps | 2017-07-27 23:13:50 +0200 |
| commit | dae111326db85383af87cdf79cd774edec30a05f (patch) | |
| tree | 86504772befba1baa6538e6fba75908bfc649f66 | |
| parent | Removed hacks for || and && now that they have been implemented properly (diff) | |
Don't allow tuples with arity > 32 (ABC-machine limitation)
| -rw-r--r-- | Sil/Compile.icl | 5 | ||||
| -rw-r--r-- | Sil/Types.dcl | 1 | ||||
| -rw-r--r-- | Sil/Types.icl | 6 |
3 files changed, 10 insertions, 2 deletions
diff --git a/Sil/Compile.icl b/Sil/Compile.icl index dc846d2..7ef48e4 100644 --- a/Sil/Compile.icl +++ b/Sil/Compile.icl @@ -30,6 +30,7 @@ import Sil.Util.Printer instance toString CompileError where toString (UndefinedName n) = "Undefined name '" <+ n <+ "'." + toString (UndefinedField f) = "Undefined field '" <+ f <+ "'." toString VariableLabel = "Variable stored at label." toString FunctionOnStack = "Function stored on the stack." toString (TypeError err e) = "Type error in '" <+ e <+ "': " <+ err @@ -376,6 +377,7 @@ where comment "Return" *> gen e *> gets returnType >>= \rettype -> + comment ("Checking type " <+ rettype <+ " on " <+ e <+ "...") *> checkType rettype e *> gets stackoffsets >>= \so -> updateReturnFrame (typeSize rettype) so *> @@ -495,13 +497,14 @@ where shrinkStack {zero & asize=i} gen e=:(Field f e`) | isTuple = - getType e` >>= \(TTuple arity tes) -> + getType e` >>= \t=:(TTuple arity tes) -> gen e` *> tell [ 'ABC'.ReplArgs arity arity , 'ABC'.Pop_a (tupleEl - 1) , 'ABC'.Update_a 0 (arity - tupleEl) , 'ABC'.Pop_a (arity - tupleEl) ] *> + if (0 >= tupleEl || tupleEl > arity) (error $ TypeError (IllegalField f t) e) nop *> case typeSize $ tes!!(tupleEl - 1) of {bsize=0} -> nop {btypes} -> mapM (flip toBStack 1) btypes *> nop diff --git a/Sil/Types.dcl b/Sil/Types.dcl index 0821078..013f064 100644 --- a/Sil/Types.dcl +++ b/Sil/Types.dcl @@ -19,6 +19,7 @@ from Sil.Syntax import :: Expression, :: Function, :: Name, :: Op1, :: Op2 :: TypeError = IllegalApplication Type Type | IllegalField Name Type + | TooHighTupleArity Int :: TypeSize = { asize :: Int diff --git a/Sil/Types.icl b/Sil/Types.icl index 55e1cc0..b2009dd 100644 --- a/Sil/Types.icl +++ b/Sil/Types.icl @@ -36,6 +36,8 @@ where 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=[]} @@ -88,7 +90,9 @@ where ( top >>= \top -> te1 >>= \te1 -> te2 >>= \te2 -> foldM tryApply top [te1,te2]) - type res (Tuple n es) = + type res (Tuple n es) + | n > 32 = Just $ Error $ 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 |