oberon.c

   1 #include <stdio.h>
   2 #include <stdlib.h>
   3 #include <stdarg.h>
   4 #include <ctype.h>
   5 #include <string.h>
   6 #include "oberon.h"
   7
   8 enum {
   9         EOF_ = 0,
  10         IDENT,
  11         MODULE,
  12         SEMICOLON,
  13         END,
  14         DOT,
  15         VAR,
  16         COLON,
  17         BEGIN,
  18         ASSIGN,
  19         INTEGER
  20 };
  21
  22 enum {
  23         MODE_VAR,
  24         MODE_INTEGER,
  25 };
  26
  27 typedef struct
  28 {
  29         int mode;
  30         int integer;
  31         oberon_var_t * var;
  32 } oberon_item_t;
  33
  34 // =======================================================================
  35 //   UTILS
  36 // =======================================================================
  37
  38 static void
  39 oberon_error(oberon_context_t * ctx, const char * fmt, ...)
  40 {
  41         va_list ptr;
  42         va_start(ptr, fmt);
  43         fprintf(stderr, "error: ");
  44         vfprintf(stderr, fmt, ptr);
  45         fprintf(stderr, "\n");
  46         fprintf(stderr, "  code_index = %i\n", ctx -> code_index);
  47         fprintf(stderr, "  c          = %c\n", ctx -> c);
  48         fprintf(stderr, "  token      = %i\n", ctx -> token);
  49         va_end(ptr);
  50         exit(1);
  51 }
  52
  53 static int
  54 oberon_item_to_type_class(oberon_context_t * ctx, oberon_item_t * item)
  55 {
  56         int class;
  57
  58         if(item -> mode == MODE_INTEGER)
  59         {
  60                 class = OBERON_TYPE_INTEGER;
  61         }
  62         else if(item -> mode == MODE_VAR)
  63         {
  64                 class = item -> var -> type -> class;
  65         }
  66         else
  67         {
  68                 oberon_error(ctx, "oberon_item_to_type_class: wat");
  69         }
  70
  71         return class;
  72 }
  73
  74 // =======================================================================
  75 //   TABLE
  76 // =======================================================================
  77
  78 static oberon_type_t *
  79 oberon_find_type(oberon_context_t * ctx, char * name)
  80 {
  81         oberon_type_t * x = ctx -> types;
  82         while(x -> next && strcmp(x -> next -> name, name) != 0)
  83         {
  84                 x = x -> next;
  85         }
  86
  87         return x -> next;
  88 }
  89
  90 static oberon_var_t *
  91 oberon_find_var(oberon_context_t * ctx, char * name)
  92 {
  93         oberon_var_t * x = ctx -> mod -> vars;
  94         while(x -> next && strcmp(x -> next -> name, name) != 0)
  95         {
  96                 x = x -> next;
  97         }
  98
  99         return x -> next;
 100 }
 101
 102 static void
 103 oberon_define_var(oberon_context_t * ctx, char * name, oberon_type_t * type)
 104 {
 105         oberon_var_t * x = ctx -> mod -> vars;
 106         while(x -> next && strcmp(x -> next -> name, name) != 0)
 107         {
 108                 x = x -> next;
 109         }
 110
 111         if(x -> next)
 112         {
 113                 oberon_error(ctx, "already defined");
 114         }
 115
 116         oberon_var_t * newvar = malloc(sizeof *newvar);
 117         memset(newvar, 0, sizeof *newvar);
 118         newvar -> name = name;
 119         newvar -> type = type;
 120
 121         x -> next = newvar;
 122 }
 123
 124 // =======================================================================
 125 //   GENERATOR
 126 // =======================================================================
 127
 128 static void
 129 oberon_generate_assign(oberon_context_t * ctx, void * src, void * dst, int size)
 130 {
 131         printf("G: %p := %p (%i);\n", dst, src, size);
 132 }
 133
 134 // =======================================================================
 135 //   SCANER
 136 // =======================================================================
 137
 138 static void
 139 oberon_get_char(oberon_context_t * ctx)
 140 {
 141         ctx -> code_index += 1;
 142         ctx -> c = ctx -> code[ctx -> code_index];
 143 }
 144
 145 static void
 146 oberon_init_scaner(oberon_context_t * ctx, const char * code)
 147 {
 148         ctx -> code = code;
 149         ctx -> code_index = 0;
 150         ctx -> c = ctx -> code[ctx -> code_index];
 151 }
 152
 153 static void
 154 oberon_read_ident(oberon_context_t * ctx)
 155 {
 156         int len = 0;
 157         int i = ctx -> code_index;
 158
 159         int c = ctx -> code[i];
 160         while(isalnum(c))
 161         {
 162                 i += 1;
 163                 len += 1;
 164                 c = ctx -> code[i];
 165         }
 166
 167         char * ident = malloc(len + 2);
 168         memcpy(ident, &ctx->code[ctx->code_index], len);
 169         ident[len + 1] = 0;
 170
 171         ctx -> code_index = i;
 172         ctx -> c = ctx -> code[i];
 173         ctx -> string = ident;
 174         ctx -> token = IDENT;
 175
 176         if(strcmp(ident, "MODULE") == 0)
 177         {
 178                 ctx -> token = MODULE;
 179         }
 180         else if(strcmp(ident, "END") == 0)
 181         {
 182                 ctx -> token = END;
 183         }
 184         else if(strcmp(ident, "VAR") == 0)
 185         {
 186                 ctx -> token = VAR;
 187         }
 188         else if(strcmp(ident, "BEGIN") == 0)
 189         {
 190                 ctx -> token = BEGIN;
 191         }
 192 }
 193
 194 static void
 195 oberon_read_integer(oberon_context_t * ctx)
 196 {
 197         int len = 0;
 198         int i = ctx -> code_index;
 199
 200         int c = ctx -> code[i];
 201         while(isdigit(c))
 202         {
 203                 i += 1;
 204                 len += 1;
 205                 c = ctx -> code[i];
 206         }
 207
 208         char * ident = malloc(len + 2);
 209         memcpy(ident, &ctx->code[ctx->code_index], len);
 210         ident[len + 1] = 0;
 211
 212         ctx -> code_index = i;
 213         ctx -> c = ctx -> code[i];
 214         ctx -> string = ident;
 215         ctx -> integer = atoi(ident);
 216         ctx -> token = INTEGER;
 217 }
 218
 219 static void
 220 oberon_skip_space(oberon_context_t * ctx)
 221 {
 222         while(isspace(ctx -> c))
 223         {
 224                 oberon_get_char(ctx);
 225         }
 226 }
 227
 228 static void
 229 oberon_read_token(oberon_context_t * ctx)
 230 {
 231         oberon_skip_space(ctx);
 232
 233         int c = ctx -> c;
 234         if(isalpha(c))
 235         {
 236                 oberon_read_ident(ctx);
 237         }
 238         else if(isdigit(c))
 239         {
 240                 oberon_read_integer(ctx);
 241         }
 242         else
 243         {
 244                 switch(c)
 245                 {
 246                         case 0: ctx -> token = EOF_; break;
 247                         case ';': ctx -> token = SEMICOLON; oberon_get_char(ctx); break;
 248                         case ':':
 249                                 /****************************************************/
 250                                 ctx -> token = COLON; oberon_get_char(ctx);
 251                                 if(ctx -> c == '=')
 252                                 {
 253                                         ctx -> token = ASSIGN;
 254                                         oberon_get_char(ctx);
 255                                 }
 256                                 break;
 257                                 /****************************************************/
 258                         case '.': ctx -> token = DOT; oberon_get_char(ctx); break;
 259                         default: oberon_error(ctx, "invalid char");
 260                 }
 261         }
 262 }
 263
 264 // =======================================================================
 265 //   PARSER
 266 // =======================================================================
 267
 268 static void
 269 oberon_expect_token(oberon_context_t * ctx, int token)
 270 {
 271         if(ctx -> token != token)
 272         {
 273                 oberon_error(ctx, "unexpected token %i (%i)", ctx -> token, token);
 274         }
 275 }
 276
 277 static void
 278 oberon_assert_token(oberon_context_t * ctx, int token)
 279 {
 280         oberon_expect_token(ctx, token);
 281         oberon_read_token(ctx);
 282 }
 283
 284 static char *
 285 oberon_assert_ident(oberon_context_t * ctx)
 286 {
 287         char * ident;
 288         oberon_expect_token(ctx, IDENT);
 289         ident = ctx -> string;
 290         oberon_read_token(ctx);
 291         return ident;
 292 }
 293
 294 static oberon_type_t *
 295 oberon_type(oberon_context_t * ctx)
 296 {
 297         char * name = oberon_assert_ident(ctx);
 298         oberon_type_t * type = oberon_find_type(ctx, name);
 299
 300         if(type == NULL)
 301         {
 302                 oberon_error(ctx, "undefined type");
 303         }
 304
 305         return type;
 306 }
 307
 308 static void
 309 oberon_var_decl(oberon_context_t * ctx)
 310 {
 311         char * name = oberon_assert_ident(ctx);
 312         oberon_assert_token(ctx, COLON);
 313         oberon_type_t * type = oberon_type(ctx);
 314         oberon_define_var(ctx, name, type);
 315 }
 316
 317 static void
 318 oberon_decl_seq(oberon_context_t * ctx)
 319 {
 320         if(ctx -> token == VAR)
 321         {
 322                 oberon_assert_token(ctx, VAR);
 323                 while(ctx -> token == IDENT)
 324                 {
 325                         oberon_var_decl(ctx);
 326                         oberon_assert_token(ctx, SEMICOLON);
 327                 }
 328         }
 329 }
 330
 331 static oberon_item_t *
 332 oberon_expr(oberon_context_t * ctx)
 333 {
 334         oberon_item_t * item = malloc(sizeof *item);
 335         memset(item, 0, sizeof *item);
 336
 337         if(ctx -> token == IDENT)
 338         {
 339                 char * name = oberon_assert_ident(ctx);
 340                 oberon_var_t * var = oberon_find_var(ctx, name);
 341                 if(var == NULL)
 342                 {
 343                         oberon_error(ctx, "undefined variable");
 344                 }
 345                 item -> mode = MODE_VAR;
 346                 item -> var = var;
 347         }
 348         else if(ctx -> token == INTEGER)
 349         {
 350                 item -> mode = MODE_INTEGER;
 351                 item -> integer = ctx -> integer;
 352                 oberon_assert_token(ctx, INTEGER);
 353         }
 354         else
 355         {
 356                 oberon_error(ctx, "invalid expression");
 357         }
 358
 359         return item;
 360 }
 361
 362 static void
 363 oberon_assign(oberon_context_t * ctx, oberon_item_t * src, oberon_item_t * dst)
 364 {
 365         if(dst -> mode == MODE_INTEGER)
 366         {
 367                 oberon_error(ctx, "invalid assignment");
 368         }
 369
 370         int src_class = oberon_item_to_type_class(ctx, src);
 371         int dst_class = oberon_item_to_type_class(ctx, dst);
 372
 373         if(src_class != dst_class)
 374         {
 375                 oberon_error(ctx, "types not matched");
 376         }
 377
 378         // TODO: code generation
 379         oberon_generate_assign(ctx, 0, 0, 4);
 380 }
 381
 382 static void
 383 oberon_statement(oberon_context_t * ctx)
 384 {
 385         oberon_item_t * item1;
 386         oberon_item_t * item2;
 387
 388         if(ctx -> token == IDENT)
 389         {
 390                 item1 = oberon_expr(ctx);
 391                 oberon_assert_token(ctx, ASSIGN);
 392                 item2 = oberon_expr(ctx);
 393                 oberon_assign(ctx, item2, item1);
 394         }
 395 }
 396
 397 static void
 398 oberon_statement_seq(oberon_context_t * ctx)
 399 {
 400         oberon_statement(ctx);
 401         while(ctx -> token == SEMICOLON)
 402         {
 403                 oberon_assert_token(ctx, SEMICOLON);
 404                 oberon_statement(ctx);
 405         }
 406 }
 407
 408 static void
 409 oberon_parse_it(oberon_context_t * ctx)
 410 {
 411         char *name1, *name2;
 412         oberon_read_token(ctx);
 413
 414         oberon_assert_token(ctx, MODULE);
 415         name1 = oberon_assert_ident(ctx);
 416         oberon_assert_token(ctx, SEMICOLON);
 417         ctx -> mod -> name = name1;
 418
 419         oberon_decl_seq(ctx);
 420
 421         if(ctx -> token == BEGIN)
 422         {
 423                 oberon_assert_token(ctx, BEGIN);
 424                 oberon_statement_seq(ctx);
 425         }
 426
 427         oberon_assert_token(ctx, END);
 428         name2 = oberon_assert_ident(ctx);
 429         oberon_assert_token(ctx, DOT);
 430
 431         if(strcmp(name1, name2) != 0)
 432         {
 433                 oberon_error(ctx, "module name not matched");
 434         }
 435 }
 436
 437 // =======================================================================
 438 //   LIBRARY
 439 // =======================================================================
 440
 441 oberon_context_t *
 442 oberon_create_context()
 443 {
 444         oberon_context_t * ctx = malloc(sizeof *ctx);
 445         memset(ctx, 0, sizeof *ctx);
 446
 447         oberon_type_t * types = malloc(sizeof *types);
 448         memset(types, 0, sizeof *types);
 449
 450         ctx -> types = types;
 451         return ctx;
 452 }
 453
 454 oberon_module_t *
 455 oberon_compile_module(oberon_context_t * ctx, const char * code)
 456 {
 457         oberon_module_t * mod = malloc(sizeof *mod);
 458         memset(mod, 0, sizeof *mod);
 459         oberon_var_t * vars = malloc(sizeof *vars);
 460         memset(vars, 0, sizeof *vars);
 461         ctx -> mod = mod;
 462         ctx -> mod -> vars = vars;
 463
 464         oberon_init_scaner(ctx, code);
 465         oberon_parse_it(ctx);
 466         return mod;
 467 }
 468
 469 void
 470 oberon_register_global_type(oberon_context_t * ctx, oberon_type_t * type)
 471 {
 472         oberon_type_t * x = ctx -> types;
 473         while(x -> next && strcmp(x -> next -> name, type -> name) != 0)
 474         {
 475                 x = x -> next;
 476         }
 477
 478         if(x -> next)
 479         {
 480                 oberon_error(ctx, "already defined");
 481         }
 482
 483         // TODO: copy type name (not a pointer)
 484         oberon_type_t * newtype = malloc(sizeof *newtype);
 485         memcpy(newtype, type, sizeof *newtype);
 486         newtype -> next = NULL;
 487
 488         x -> next = newtype;
 489 }