Добавлены процедуры и проверка результата в выражениях

diff --git a/oberon.c b/oberon.c
index ec4cab05b3804d3c204407e28dcbb2eff1ccea22..440364361e45956f86091d3022fd50b3099f1026 100644 (file)
--- a/oberon.c
+++ b/oberon.c
@@ -37,7 +37,8 @@ enum {
        DIV,
        MOD,
        AND,
-       NOT
+       NOT,
+       PROCEDURE
 };
 
 // =======================================================================
@@ -59,46 +60,6 @@ oberon_error(oberon_context_t * ctx, const char * fmt, ...)
        exit(1);
 }
 
-/*
-static int
-oberon_item_to_type_class(oberon_context_t * ctx, oberon_item_t * item)
-{
-       int class;
-
-       switch(item -> mode)
-       {
-               case MODE_INTEGER:
-                       class = OBERON_TYPE_INTEGER;
-                       break;
-               case MODE_BOOLEAN:
-                       class = OBERON_TYPE_BOOLEAN;
-                       break;
-               case MODE_VAR:
-                       class = item -> var -> type -> class;
-                       break;
-               default:
-                       oberon_error(ctx, "oberon_item_to_type_class: wat");
-                       break;
-       }
-
-       return class;
-}
-*/
-
-/*
-static void
-oberon_autocast_to(oberon_context_t * ctx, oberon_item_t * from, oberon_item_t * to)
-{
-       int from_class = oberon_item_to_type_class(ctx, from);
-       int to_class = oberon_item_to_type_class(ctx, to);
-
-       if(from_class != to_class)
-       {
-               oberon_error(ctx, "oberon_autocast_to: types not matched %i -> %i", from_class, to_class);
-       }
-}
-*/
-
 // =======================================================================
 //   TABLE
 // ======================================================================= 
@@ -228,6 +189,10 @@ oberon_read_ident(oberon_context_t * ctx)
        {
                ctx -> token = MOD;
        }
+       else if(strcmp(ident, "PROCEDURE") == 0)
+       {
+               ctx -> token = PROCEDURE;
+       }
 }
 
 static void
@@ -414,9 +379,37 @@ oberon_new_item(int mode, oberon_type_t * result)
 }
 
 static oberon_expr_t *
-oberon_make_not(oberon_context_t * ctx, oberon_expr_t * expr)
+oberon_make_unary_op(oberon_context_t * ctx, int token, oberon_expr_t * a)
 {
-       return oberon_new_operator(OP_LOGIC_NOT, expr -> result, expr, NULL);
+       oberon_expr_t * expr;
+       oberon_type_t * result;
+
+       result = a -> result;
+
+       if(token == MINUS)
+       {
+               if(result -> class != OBERON_TYPE_INTEGER)
+               {
+                       oberon_error(ctx, "incompatible operator type");
+               }
+
+               expr = oberon_new_operator(OP_UNARY_MINUS, result, a, NULL);
+       }
+       else if(token == NOT)
+       {
+               if(result -> class != OBERON_TYPE_BOOLEAN)
+               {
+                       oberon_error(ctx, "incompatible operator type");
+               }
+
+               expr = oberon_new_operator(OP_LOGIC_NOT, result, a, NULL);
+       }
+       else
+       {
+               oberon_error(ctx, "oberon_make_unary_op: wat");
+       }
+
+       return expr;
 }
 
 static oberon_expr_t *
@@ -461,7 +454,7 @@ oberon_factor(oberon_context_t * ctx)
                case NOT:
                        oberon_assert_token(ctx, NOT);
                        expr = oberon_factor(ctx);
-                       expr = oberon_make_not(ctx, expr);
+                       expr = oberon_make_unary_op(ctx, NOT, expr);
                        break;
                default:
                        oberon_error(ctx, "invalid expression");
@@ -470,37 +463,144 @@ oberon_factor(oberon_context_t * ctx)
        return expr;
 }
 
-static oberon_expr_t *
-oberon_make_mul_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_expr_t * b)
-{
-       oberon_expr_t * expr;
-       oberon_type_t * result;
-
-       result = a -> result;
+/*
+ * oberon_autocast_binary_op автоматически переобразовывеат тип по след. правилам:
+ *   1. Классы обоих типов должны быть одинаковы
+ *   2. В качестве результата должен быть выбран больший тип.
+ *   3. Если размер результат не должен быть меньше чем базовый int
+ */
 
-       if(token == STAR)
+static void
+oberon_autocast_binary_op(oberon_context_t * ctx, oberon_type_t * a, oberon_type_t * b, oberon_type_t ** result)
+{
+       if((a -> class) != (b -> class))
        {
-               expr = oberon_new_operator(OP_MUL, result, a, b);
+               oberon_error(ctx, "incompatible types");
        }
-       else if(token == SLASH)
+
+       if((a -> size) > (b -> size))
        {
-               expr = oberon_new_operator(OP_DIV, result, a, b);
+               *result = a;
        }
-       else if(token == DIV)
+       else
        {
-               expr = oberon_new_operator(OP_DIV, result, a, b);
+               *result = b;
        }
-       else if(token == MOD)
+
+       if(((*result) -> class) == OBERON_TYPE_INTEGER)
        {
-               expr = oberon_new_operator(OP_MOD, result, a, b);
+               if(((*result) -> size) < (ctx -> int_type -> size))
+               {
+                       *result = ctx -> int_type;
+               }
        }
-       else if(token == AND)
+
+       /* TODO: cast types */
+}
+
+#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 oberon_expr_t *
+oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_expr_t * b)
+{
+       oberon_expr_t * expr;
+       oberon_type_t * result;
+
+       oberon_autocast_binary_op(ctx, a -> result, b -> result, &result);
+
+       if(ITMAKESBOOLEAN(token))
        {
-               expr = oberon_new_operator(OP_LOGIC_AND, result, a, b);
+               if(ITUSEONLYINTEGER(token))
+               {
+                       if(a -> result -> class != OBERON_TYPE_INTEGER
+                               && b -> result -> class != OBERON_TYPE_INTEGER)
+                       {
+                               oberon_error(ctx, "used only with integer types");
+                       }
+               }
+               else if(ITUSEONLYBOOLEAN(token))
+               {
+                       if(a -> result -> class != OBERON_TYPE_BOOLEAN
+                               && b -> result -> class != OBERON_TYPE_BOOLEAN)
+                       {
+                               oberon_error(ctx, "used only with boolean type");
+                       }
+               }
+
+               if(token == EQUAL)
+               {
+                       expr = oberon_new_operator(OP_EQ, result, a, b);
+               }
+               else if(token == NEQ)
+               {
+                       expr = oberon_new_operator(OP_NEQ, result, a, b);
+               }
+               else if(token == LESS)
+               {
+                       expr = oberon_new_operator(OP_LSS, result, a, b);
+               }
+               else if(token == LEQ)
+               {
+                       expr = oberon_new_operator(OP_LEQ, result, a, b);
+               }
+               else if(token == GREAT)
+               {
+                       expr = oberon_new_operator(OP_GRT, result, a, b);
+               }
+               else if(token == GEQ)
+               {
+                       expr = oberon_new_operator(OP_GEQ, result, a, b);
+               }
+               else if(token == OR)
+               {
+                       expr = oberon_new_operator(OP_LOGIC_OR, result, a, b);
+               }
+               else if(token == AND)
+               {
+                       expr = oberon_new_operator(OP_LOGIC_AND, result, a, b);
+               }
+               else
+               {
+                       oberon_error(ctx, "oberon_make_bin_op: bool wat");
+               }
        }
        else
        {
-               oberon_error(ctx, "oberon_make_mul_op: wat");
+               if(token == PLUS)
+               {
+                       expr = oberon_new_operator(OP_ADD, result, a, b);
+               }
+               else if(token == MINUS)
+               {
+                       expr = oberon_new_operator(OP_SUB, result, a, b);
+               }
+               else if(token == STAR)
+               {
+                       expr = oberon_new_operator(OP_MUL, result, a, b);
+               }
+               else if(token == SLASH)
+               {
+                       expr = oberon_new_operator(OP_DIV, result, a, b);
+               }
+               else if(token == DIV)
+               {
+                       expr = oberon_new_operator(OP_DIV, result, a, b);
+               }
+               else if(token == MOD)
+               {
+                       expr = oberon_new_operator(OP_MOD, result, a, b);
+               }
+               else
+               {
+                       oberon_error(ctx, "oberon_make_bin_op: bin wat");
+               }
        }
 
        return expr;
@@ -521,46 +621,12 @@ oberon_term_expr(oberon_context_t * ctx)
                oberon_read_token(ctx);
 
                oberon_expr_t * inter = oberon_factor(ctx);
-               expr = oberon_make_mul_op(ctx, token, expr, inter);
-       }
-
-       return expr;
-}
-
-static oberon_expr_t *
-oberon_make_add_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_expr_t * b)
-{
-       oberon_expr_t * expr;
-       oberon_type_t * result;
-
-       result = a -> result;
-
-       if(token == PLUS)
-       {
-               expr = oberon_new_operator(OP_ADD, result, a, b);
-       }
-       else if(token == MINUS)
-       {
-               expr = oberon_new_operator(OP_SUB, result, a, b);
-       }
-       else if(token == OR)
-       {
-               expr = oberon_new_operator(OP_LOGIC_OR, result, a, b);
-       }
-       else
-       {
-               oberon_error(ctx, "oberon_make_add_op: wat");
+               expr = oberon_make_bin_op(ctx, token, expr, inter);
        }
 
        return expr;
 }
 
-static oberon_expr_t *
-oberon_make_unary_minus(oberon_context_t * ctx, oberon_expr_t * expr)
-{
-       return oberon_new_operator(OP_UNARY_MINUS, expr -> result, expr, NULL);
-}
-
 #define ISADDOP(x) \
        ((x) >= PLUS && (x) <= OR)
 
@@ -588,57 +654,17 @@ oberon_simple_expr(oberon_context_t * ctx)
                oberon_read_token(ctx);
 
                oberon_expr_t * inter = oberon_term_expr(ctx);
-               expr = oberon_make_add_op(ctx, token, expr, inter);
+               expr = oberon_make_bin_op(ctx, token, expr, inter);
        }
 
        if(minus)
        {
-               expr = oberon_make_unary_minus(ctx, expr);
+               expr = oberon_make_unary_op(ctx, MINUS, expr);
        }
 
        return expr;
 }
 
-static oberon_expr_t *
-oberon_make_relation(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_expr_t * b)
-{
-       oberon_expr_t * expr;
-       oberon_type_t * result;
-
-       result = a -> result;
-
-       if(token == EQUAL)
-       {
-               expr = oberon_new_operator(OP_EQ, result, a, b);
-       }
-       else if(token == NEQ)
-       {
-               expr = oberon_new_operator(OP_NEQ, result, a, b);
-       }
-       else if(token == LESS)
-       {
-               expr = oberon_new_operator(OP_LSS, result, a, b);
-       }
-       else if(token == LEQ)
-       {
-               expr = oberon_new_operator(OP_LEQ, result, a, b);
-       }
-       else if(token == GREAT)
-       {
-               expr = oberon_new_operator(OP_GRT, result, a, b);
-       }
-       else if(token == GEQ)
-       {
-               expr = oberon_new_operator(OP_GEQ, result, a, b);
-       }
-       else
-       {
-               oberon_error(ctx, "oberon_make_relation: wat");
-       }       
-
-       return expr;
-}
-
 #define ISRELATION(x) \
        ((x) >= EQUAL && (x) <= GEQ)
 
@@ -654,7 +680,7 @@ oberon_expr(oberon_context_t * ctx)
                oberon_read_token(ctx);
 
                oberon_expr_t * inter = oberon_simple_expr(ctx);
-               expr = oberon_make_relation(ctx, token, expr, inter);
+               expr = oberon_make_bin_op(ctx, token, expr, inter);
        }
 
        return expr;
@@ -664,6 +690,8 @@ oberon_expr(oberon_context_t * ctx)
 //   PARSER
 // =======================================================================
 
+static void oberon_statement_seq(oberon_context_t * ctx);
+
 static void
 oberon_expect_token(oberon_context_t * ctx, int token)
 {
@@ -712,6 +740,45 @@ oberon_var_decl(oberon_context_t * ctx)
        oberon_define_var(ctx, name, type);
 }
 
+static void
+oberon_make_procedure_begin(oberon_context_t * ctx, char * name)
+{
+       
+}
+
+static void
+oberon_make_procedure_end(oberon_context_t * ctx)
+{
+
+}
+
+static void
+oberon_proc_decl(oberon_context_t * ctx)
+{
+       oberon_assert_token(ctx, PROCEDURE);
+
+       char * name;
+       name = oberon_assert_ident(ctx);
+
+       oberon_assert_token(ctx, SEMICOLON);
+
+       oberon_make_procedure_begin(ctx, name);
+       if(ctx -> token == BEGIN)
+       {
+               oberon_assert_token(ctx, BEGIN);
+               oberon_statement_seq(ctx);
+       }
+       oberon_make_procedure_end(ctx);
+
+       oberon_assert_token(ctx, END);
+       char * name2 = oberon_assert_ident(ctx);
+
+       if(strcmp(name2, name) != 0)
+       {
+               oberon_error(ctx, "procedure name not matched");
+       }
+}
+
 static void
 oberon_decl_seq(oberon_context_t * ctx)
 {
@@ -724,17 +791,29 @@ oberon_decl_seq(oberon_context_t * ctx)
                        oberon_assert_token(ctx, SEMICOLON);
                }
        }
+
+       if(ctx -> token == PROCEDURE)
+       {
+               oberon_proc_decl(ctx);
+               oberon_assert_token(ctx, SEMICOLON);
+       }
 }
 
 static void
 oberon_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst)
 {
-//     if(dst -> mode == MODE_INTEGER)
-//     {
-//             oberon_error(ctx, "invalid assignment");
-//     }
-//
-//     oberon_autocast_to(ctx, src, dst);
+       if(src -> result -> class != dst -> result -> class)
+       {
+               oberon_error(ctx, "incompatible assignment types");
+       }
+
+       if(dst -> result -> class == OBERON_TYPE_INTEGER)
+       {
+               if((dst -> result -> size) < (src -> result -> size))
+               {
+                       oberon_error(ctx, "incompatible assignment type size");
+               }
+       }
 
        oberon_generate_assign(ctx, src, dst);
 }

diff --git a/oberon.h b/oberon.h
index 7ed16291b9b4da45a0c1b9bb7db798b1e427f067..b2f0965f3c6acadd009dd22e99d4e5a1df8bc270 100644 (file)
--- a/oberon.h
+++ b/oberon.h
@@ -3,6 +3,7 @@
 
 typedef struct oberon_var_s oberon_var_t;
 typedef struct oberon_type_s oberon_type_t;
+typedef struct oberon_proc_s oberon_proc_t;
 typedef struct oberon_module_s oberon_module_t;
 typedef struct oberon_context_s oberon_context_t;
 
@@ -30,10 +31,21 @@ struct oberon_var_s
        void * gen_var;
 };
 
+struct oberon_proc_s
+{
+       char * name;
+
+       oberon_proc_t * next;
+
+       void * gen_proc;
+};
+
 struct oberon_module_s
 {
        char * name;
+
        oberon_var_t * vars;
+       oberon_proc_t * procs;
 
        void (* begin)();
 };

diff --git a/test.c b/test.c
index 0837de4ef28f6ba05ca3dbe8f4c191e95fd0caa5..2bea391195d42f982cbaf1688e999242ee771586 100644 (file)
--- a/test.c
+++ b/test.c
@@ -7,10 +7,16 @@ static const char source[] =
        "       k : INTEGER;"
        "       i : INTEGER;"
        "       b : BOOLEAN;"
+       ""
+       "PROCEDURE Tier;"
        "BEGIN"
-       "       k := -10 + 1;"
+       "       "
+       "END Tier;"
+       ""
+       "BEGIN"
+       "       k := 1;"
        "       i := k;"
-       "       b := ~TRUE OR FALSE;"
+       "       b := TRUE;"
        "END Test."
 ;
 
@@ -22,6 +28,7 @@ main(int argc, char ** argv)
 {
        ctx = oberon_create_context();
        mod = oberon_compile_module(ctx, source);
+       //mod -> begin();
        oberon_destroy_context(ctx);
        return 0;
 }