DEADSOFTWARE

Исправлено присваивание и синхронизация сравнений со стандартом
[dsw-obn.git] / src / oberon.c
index ece881fc44366290a324ac54b55def84b1c9804b..9738056b94124b347e771b1bb541364e83859ae6 100644 (file)
@@ -1573,17 +1573,9 @@ oberon_qualident_expr(oberon_context_t * ctx)
        return expr;
 }
 
-static oberon_expr_t *
-oberon_make_type_guard(oberon_context_t * ctx, oberon_expr_t * expr, oberon_object_t * objtype)
+static void
+oberon_check_type_guard(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * type)
 {
-       oberon_type_t * type;
-
-       if(objtype -> class != OBERON_CLASS_TYPE)
-       {
-               oberon_error(ctx, "must be type");
-       }
-       type = objtype -> type;
-
        /* Охрана типа применима, если */
        /*   1. v - параметр-переменная типа запись, или v - указатель, и если */
        /*   2. T - расширение статического типа v */
@@ -1594,7 +1586,8 @@ oberon_make_type_guard(oberon_context_t * ctx, oberon_expr_t * expr, oberon_obje
        {
                // accept
        }
-       else if(expr -> result -> class == OBERON_TYPE_POINTER)
+       else if(expr -> result -> class == OBERON_TYPE_POINTER
+               || expr -> result -> class == OBERON_TYPE_RECORD)
        {
                // accept
        }
@@ -1604,6 +1597,20 @@ oberon_make_type_guard(oberon_context_t * ctx, oberon_expr_t * expr, oberon_obje
        }
 
        oberon_check_record_compatibility(ctx, type, expr -> result);
+}
+
+static oberon_expr_t *
+oberon_make_type_guard(oberon_context_t * ctx, oberon_expr_t * expr, oberon_object_t * objtype)
+{
+       oberon_type_t * type;
+
+       if(objtype -> class != OBERON_CLASS_TYPE)
+       {
+               oberon_error(ctx, "must be type");
+       }
+       type = objtype -> type;
+
+       oberon_check_type_guard(ctx, expr, type);
        return oberno_make_record_cast(ctx, expr, objtype -> type);
 }
 
@@ -1858,15 +1865,6 @@ oberon_factor(oberon_context_t * ctx)
        return expr;
 }
 
-#define ITMAKESBOOLEAN(x) \
-       (((x) >= EQUAL && (x) <= GEQ) || ((x) == OR) || ((x) == AND))
-
-#define ITUSEONLYINTEGER(x) \
-       ((x) >= LESS && (x) <= GEQ)
-
-#define ITUSEONLYBOOLEAN(x) \
-       (((x) == OR) || ((x) == AND))
-
 static void
 oberon_autocast_to_real(oberon_context_t * ctx, oberon_expr_t ** e)
 {
@@ -1888,6 +1886,49 @@ oberon_autocast_to_real(oberon_context_t * ctx, oberon_expr_t ** e)
        }
 }
 
+static bool
+oberon_is_numeric_type(oberon_type_t * t)
+{
+       return (t -> class == OBERON_TYPE_INTEGER) || (t -> class == OBERON_TYPE_REAL);
+}
+
+static bool
+oberon_is_char_type(oberon_type_t * t)
+{
+       return (t -> class == OBERON_TYPE_CHAR);
+}
+
+static bool
+oberon_is_string_type(oberon_type_t * t)
+{
+       return (t -> class == OBERON_TYPE_STRING)
+               || (t -> class == OBERON_TYPE_ARRAY && t -> base -> class == OBERON_TYPE_CHAR);
+}
+
+static bool
+oberon_is_boolean_type(oberon_type_t * t)
+{
+       return (t -> class == OBERON_TYPE_BOOLEAN);
+}
+
+static bool
+oberon_is_set_type(oberon_type_t * t)
+{
+       return (t -> class == OBERON_TYPE_SET);
+}
+
+static bool
+oberon_is_pointer_type(oberon_type_t * t)
+{
+       return (t -> class == OBERON_TYPE_POINTER) || (t -> class == OBERON_TYPE_NIL);
+}
+
+static bool
+oberon_is_procedure_type(oberon_type_t * t)
+{
+       return (t -> class == OBERON_TYPE_POINTER) || (t -> class == OBERON_TYPE_NIL);
+}
+
 static oberon_expr_t *
 oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_expr_t * b)
 {
@@ -1912,66 +1953,82 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_
        }
        else if(token == IS)
        {
-               oberon_type_t * v = a -> result;
-               if(v -> class == OBERON_TYPE_POINTER)
-               {
-                       v = v -> base;
-                       if(v -> class != OBERON_TYPE_RECORD)
-                       {
-                               oberon_error(ctx, "must be record");
-                       }
-               }
-               else if(v -> class != OBERON_TYPE_RECORD)
-               {
-                       oberon_error(ctx, "must be record");
-               }               
-
                if(b -> is_item == false || b -> item.mode != MODE_TYPE)
                {
                        oberon_error(ctx, "requires type");
                }
 
-               oberon_type_t * t = b -> result;
-               if(t -> class == OBERON_TYPE_POINTER)
-               {
-                       t = t -> base;
-                       if(t -> class != OBERON_TYPE_RECORD)
-                       {
-                               oberon_error(ctx, "must be record");
-                       }
-               }
-               else if(t -> class != OBERON_TYPE_RECORD)
-               {
-                       oberon_error(ctx, "must be record");
-               }
-
                result = ctx -> bool_type;
+               oberon_check_type_guard(ctx, a, b -> result);
                expr = oberon_new_operator(OP_IS, result, a, b);
        }
-       else if(ITMAKESBOOLEAN(token))
+       else if((token >= EQUAL && token <= GEQ) || token == OR || token == AND)
        {
-               if(ITUSEONLYINTEGER(token))
+               if(token >= LESS && token <= GEQ)
+               {
+                       if(oberon_is_numeric_type(a -> result) && oberon_is_numeric_type(b -> result))
+                       {
+                               // accept
+                       }
+                       else if(oberon_is_char_type(a -> result) && oberon_is_char_type(b -> result))
+                       {
+                               // accept
+                       }
+                       else if(oberon_is_string_type(a -> result) && oberon_is_string_type(b -> result))
+                       {
+                               // accept
+                       }
+                       else
+                       {
+                               oberon_error(ctx, "invalid comparation");
+                       }
+               }
+               else if(token == EQUAL || token == NEQ)
                {
-                       if(a -> result -> class == OBERON_TYPE_INTEGER
-                               || b -> result -> class == OBERON_TYPE_INTEGER
-                               || a -> result -> class == OBERON_TYPE_REAL
-                               || b -> result -> class == OBERON_TYPE_REAL)
+                       if(oberon_is_numeric_type(a -> result) && oberon_is_numeric_type(b -> result))
+                       {
+                               // accept
+                       }
+                       else if(oberon_is_char_type(a -> result) && oberon_is_char_type(b -> result))
+                       {
+                               // accept
+                       }
+                       else if(oberon_is_string_type(a -> result) && oberon_is_string_type(b -> result))
+                       {
+                               // accept
+                       }
+                       else if(oberon_is_boolean_type(a -> result) && oberon_is_boolean_type(b -> result))
+                       {
+                               // accept
+                       }
+                       else if(oberon_is_set_type(a -> result) && oberon_is_set_type(b -> result))
+                       {
+                               // accept
+                       }
+                       else if(oberon_is_pointer_type(a -> result) && oberon_is_pointer_type(b -> result))
+                       {
+                               // accept
+                       }
+                       else if(oberon_is_procedure_type(a -> result) && oberon_is_procedure_type(b -> result))
                        {
                                // accept
                        }
                        else
                        {
-                               oberon_error(ctx, "used only with numeric types");
+                               oberon_error(ctx, "invalid comparation");
                        }
                }
-               else if(ITUSEONLYBOOLEAN(token))
+               else if(token == AND || token == OR)
                {
-                       if(a -> result -> class != OBERON_TYPE_BOOLEAN
-                               || b -> result -> class != OBERON_TYPE_BOOLEAN)
+                       if(!oberon_is_boolean_type(a -> result) || !oberon_is_boolean_type(b -> result))
                        {
-                               oberon_error(ctx, "used only with boolean type");
+                               oberon_error(ctx, "invalid comparation");
                        }
                }
+               else
+               {
+                       oberon_error(ctx, "wat");
+               }
 
                oberon_autocast_binary_op(ctx, &a, &b);
                result = ctx -> bool_type;