fixed minor problem with subranges

diff --git a/lang/m2/comp/declar.g b/lang/m2/comp/declar.g
index f4888ad..82ff2cc 100644 (file)
--- a/lang/m2/comp/declar.g
+++ b/lang/m2/comp/declar.g
@@ -194,23 +194,19 @@ type(register t_type **ptp;):
        ProcedureType(ptp)
 ;
 
-SimpleType(register t_type **ptp;)
-{
-       t_type *tp;
-} :
+SimpleType(register t_type **ptp;) :
        qualtype(ptp)
        [
                /* nothing */
        |
-               SubrangeType(&tp)
+               SubrangeType(ptp)
                /* The subrange type is given a base type by the
                   qualident (this is new modula-2).
                */
-                       { chk_basesubrange(tp, *ptp); *ptp = tp; }
        ]
 |
        enumeration(ptp)
-|
+|                      { *ptp = 0; }
        SubrangeType(ptp)
 ;
 
@@ -247,7 +243,7 @@ SubrangeType(t_type **ptp;)
        '[' ConstExpression(&nd1)
        UPTO ConstExpression(&nd2)
        ']'
-                       { *ptp = subr_type(nd1, nd2);
+                       { *ptp = subr_type(nd1, nd2, *ptp);
                          FreeNode(nd1);
                          FreeNode(nd2);
                        }

diff --git a/lang/m2/comp/type.c b/lang/m2/comp/type.c
index be11142..6a78627 100644 (file)
--- a/lang/m2/comp/type.c
+++ b/lang/m2/comp/type.c
@@ -279,39 +279,6 @@ node_error(nd,"identifier \"%s\" is not a type", df->df_idf->id_text);
        return error_type;
 }
 
-chk_basesubrange(tp, base)
-       register t_type *tp, *base;
-{
-       /*      A subrange had a specified base. Check that the bases conform.
-       */
-
-       assert(tp->tp_fund == T_SUBRANGE);
-
-       if (base->tp_fund == T_SUBRANGE) {
-               /* Check that the bounds of "tp" fall within the range
-                  of "base".
-               */
-               if (! in_range(tp->sub_lb, base) || 
-                   ! in_range(tp->sub_ub, base)) {
-                       error("base type has insufficient range");
-               }
-               base = base->tp_next;
-       }
-
-       if ((base->tp_fund & (T_ENUMERATION|T_CHAR)) || base == card_type) {
-               if (tp->tp_next != base) {
-                       error("specified base does not conform");
-               }
-       }
-       else if (base == int_type) {
-               if (tp->tp_next == card_type &&
-                   ! chk_bounds(tp->sub_ub,max_int[(int)int_size],T_CARDINAL)){
-                       error("upperbound too large for type INTEGER");
-               }
-       }
-       else    error("illegal base for a subrange");
-       tp->tp_next = base;
-}
 
 int
 chk_bounds(l1, l2, fund)
@@ -351,23 +318,29 @@ in_range(i, tp)
 }
 
 t_type *
-subr_type(lb, ub)
+subr_type(lb, ub, base)
        register t_node *lb;
        t_node *ub;
+       t_type *base;
 {
        /*      Construct a subrange type from the constant expressions
                indicated by "lb" and "ub", but first perform some
-               checks
+               checks. "base" is either a user-specified base-type, or NULL.
        */
        register t_type *tp = BaseType(lb->nd_type);
        register t_type *res;
 
        if (tp == intorcard_type) {
                /* Lower bound >= 0; in this case, the base type is CARDINAL,
-                  according to the language definition, par. 6.3
+                  according to the language definition, par. 6.3.
+                  But what if the upper-bound is of type INTEGER (f.i.
+                  MAX(INTEGER)? The Report does not answer this. Fix this
+                  for the time being, by making it an INTEGER subrange.
+                  ???
                */
                assert(lb->nd_INT >= 0);
-               tp = card_type;
+               if (BaseType(ub->nd_type) == int_type) tp = int_type;
+               else tp = card_type;
        }
 
        if (!ChkCompat(&ub, tp, "subrange bounds")) {
@@ -381,17 +354,18 @@ subr_type(lb, ub)
                return error_type;
        }
 
+       /* Now construct resulting type
+       */
+       res = construct_type(T_SUBRANGE, tp);
+       res->sub_lb = lb->nd_INT;
+       res->sub_ub = ub->nd_INT;
+
        /* Check bounds
        */
        if (! chk_bounds(lb->nd_INT, ub->nd_INT, tp->tp_fund)) {
                node_error(lb, "lower bound exceeds upper bound");
        }
 
-       /* Now construct resulting type
-       */
-       res = construct_type(T_SUBRANGE, tp);
-       res->sub_lb = lb->nd_INT;
-       res->sub_ub = ub->nd_INT;
        if (tp == card_type) {
                u_small(res, res->sub_ub);
        }
@@ -406,6 +380,35 @@ subr_type(lb, ub)
                        res->tp_align = short_align;
                }
        }
+
+       if (base) {
+               if (base->tp_fund == T_SUBRANGE) {
+                       /* Check that the bounds of "res" fall within the range
+                          of "base".
+                       */
+                       if (! in_range(res->sub_lb, base) || 
+                           ! in_range(res->sub_ub, base)) {
+                               error("base type has insufficient range");
+                       }
+                       base = base->tp_next;
+               }
+               if ((base->tp_fund & (T_ENUMERATION|T_CHAR)) ||
+                   base == card_type) {
+                       if (res->tp_next != base) {
+                               error("specified basetype for subrange not compatible with bounds");
+                       }
+               }
+               else if (base == int_type) {
+                       if (res->tp_next == card_type &&
+                           ! chk_bounds(res->sub_ub,
+                                        max_int[(int)int_size],
+                                        T_CARDINAL)){
+                               error("upperbound too large for type INTEGER");
+                       }
+               }
+               else    error("illegal base for a subrange");
+               res->tp_next = base;
+       }
        return res;
 }