oberon.c

   1 #include <stdio.h>
   2 #include <stdlib.h>
   3 #include <stdarg.h>
   4 #include <ctype.h>
   5 #include <string.h>
   6
   7 #include "oberon.h"
   8 #include "generator.h"
   9
  10 enum {
  11         EOF_ = 0,
  12         IDENT,
  13         MODULE,
  14         SEMICOLON,
  15         END,
  16         DOT,
  17         VAR,
  18         COLON,
  19         BEGIN,
  20         ASSIGN,
  21         INTEGER,
  22         TRUE,
  23         FALSE,
  24         LPAREN,
  25         RPAREN
  26 };
  27
  28 // =======================================================================
  29 //   UTILS
  30 // =======================================================================
  31
  32 void
  33 oberon_error(oberon_context_t * ctx, const char * fmt, ...)
  34 {
  35         va_list ptr;
  36         va_start(ptr, fmt);
  37         fprintf(stderr, "error: ");
  38         vfprintf(stderr, fmt, ptr);
  39         fprintf(stderr, "\n");
  40         fprintf(stderr, "  code_index = %i\n", ctx -> code_index);
  41         fprintf(stderr, "  c          = %c\n", ctx -> c);
  42         fprintf(stderr, "  token      = %i\n", ctx -> token);
  43         va_end(ptr);
  44         exit(1);
  45 }
  46
  47 static int
  48 oberon_item_to_type_class(oberon_context_t * ctx, oberon_item_t * item)
  49 {
  50         int class;
  51
  52         switch(item -> mode)
  53         {
  54                 case MODE_INTEGER:
  55                         class = OBERON_TYPE_INTEGER;
  56                         break;
  57                 case MODE_BOOLEAN:
  58                         class = OBERON_TYPE_BOOLEAN;
  59                         break;
  60                 case MODE_VAR:
  61                         class = item -> var -> type -> class;
  62                         break;
  63                 default:
  64                         oberon_error(ctx, "oberon_item_to_type_class: wat");
  65                         break;
  66         }
  67
  68         return class;
  69 }
  70
  71 static void
  72 oberon_autocast_to(oberon_context_t * ctx, oberon_item_t * from, oberon_item_t * to)
  73 {
  74         int from_class = oberon_item_to_type_class(ctx, from);
  75         int to_class = oberon_item_to_type_class(ctx, to);
  76
  77         if(from_class != to_class)
  78         {
  79                 oberon_error(ctx, "oberon_autocast_to: types not matched %i -> %i", from_class, to_class);
  80         }
  81 }
  82
  83 // =======================================================================
  84 //   TABLE
  85 // =======================================================================
  86
  87 static oberon_type_t *
  88 oberon_find_type(oberon_context_t * ctx, char * name)
  89 {
  90         oberon_type_t * x = ctx -> types;
  91         while(x -> next && strcmp(x -> next -> name, name) != 0)
  92         {
  93                 x = x -> next;
  94         }
  95
  96         return x -> next;
  97 }
  98
  99 static oberon_var_t *
 100 oberon_find_var(oberon_context_t * ctx, char * name)
 101 {
 102         oberon_var_t * x = ctx -> mod -> vars;
 103         while(x -> next && strcmp(x -> next -> name, name) != 0)
 104         {
 105                 x = x -> next;
 106         }
 107
 108         return x -> next;
 109 }
 110
 111 static void
 112 oberon_define_var(oberon_context_t * ctx, char * name, oberon_type_t * type)
 113 {
 114         oberon_var_t * x = ctx -> mod -> vars;
 115         while(x -> next && strcmp(x -> next -> name, name) != 0)
 116         {
 117                 x = x -> next;
 118         }
 119
 120         if(x -> next)
 121         {
 122                 oberon_error(ctx, "already defined");
 123         }
 124
 125         oberon_var_t * newvar = malloc(sizeof *newvar);
 126         memset(newvar, 0, sizeof *newvar);
 127         newvar -> name = name;
 128         newvar -> type = type;
 129         oberon_generator_init_var(ctx, newvar);
 130
 131         x -> next = newvar;
 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 + 1);
 168         memcpy(ident, &ctx->code[ctx->code_index], len);
 169         ident[len] = 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         else if(strcmp(ident, "TRUE") == 0)
 193         {
 194                 ctx -> token = TRUE;
 195         }
 196         else if(strcmp(ident, "FALSE") == 0)
 197         {
 198                 ctx -> token = FALSE;
 199         }
 200 }
 201
 202 static void
 203 oberon_read_integer(oberon_context_t * ctx)
 204 {
 205         int len = 0;
 206         int i = ctx -> code_index;
 207
 208         int c = ctx -> code[i];
 209         while(isdigit(c))
 210         {
 211                 i += 1;
 212                 len += 1;
 213                 c = ctx -> code[i];
 214         }
 215
 216         char * ident = malloc(len + 2);
 217         memcpy(ident, &ctx->code[ctx->code_index], len);
 218         ident[len + 1] = 0;
 219
 220         ctx -> code_index = i;
 221         ctx -> c = ctx -> code[i];
 222         ctx -> string = ident;
 223         ctx -> integer = atoi(ident);
 224         ctx -> token = INTEGER;
 225 }
 226
 227 static void
 228 oberon_skip_space(oberon_context_t * ctx)
 229 {
 230         while(isspace(ctx -> c))
 231         {
 232                 oberon_get_char(ctx);
 233         }
 234 }
 235
 236 static void
 237 oberon_read_symbol(oberon_context_t * ctx)
 238 {
 239         int c = ctx -> c;
 240         switch(c)
 241         {
 242                 case 0:
 243                         ctx -> token = EOF_;
 244                         break;
 245                 case ';':
 246                         ctx -> token = SEMICOLON;
 247                         oberon_get_char(ctx);
 248                         break;
 249                 case ':':
 250                         ctx -> token = COLON;
 251                         oberon_get_char(ctx);
 252                         if(ctx -> c == '=')
 253                         {
 254                                 ctx -> token = ASSIGN;
 255                                 oberon_get_char(ctx);
 256                         }
 257                         break;
 258                 case '.':
 259                         ctx -> token = DOT;
 260                         oberon_get_char(ctx);
 261                         break;
 262                 case '(':
 263                         ctx -> token = LPAREN;
 264                         oberon_get_char(ctx);
 265                         break;
 266                 case ')':
 267                         ctx -> token = RPAREN;
 268                         oberon_get_char(ctx);
 269                         break;
 270                 default:
 271                         oberon_error(ctx, "invalid char");
 272                         break;
 273         }
 274 }
 275
 276 static void
 277 oberon_read_token(oberon_context_t * ctx)
 278 {
 279         oberon_skip_space(ctx);
 280
 281         int c = ctx -> c;
 282         if(isalpha(c))
 283         {
 284                 oberon_read_ident(ctx);
 285         }
 286         else if(isdigit(c))
 287         {
 288                 oberon_read_integer(ctx);
 289         }
 290         else
 291         {
 292                 oberon_read_symbol(ctx);
 293         }
 294 }
 295
 296 // =======================================================================
 297 //   EXPR
 298 // =======================================================================
 299
 300 static void oberon_expect_token(oberon_context_t * ctx, int token);
 301 static oberon_item_t * oberon_expr(oberon_context_t * ctx);
 302 static void oberon_assert_token(oberon_context_t * ctx, int token);
 303 static char * oberon_assert_ident(oberon_context_t * ctx);
 304
 305 static oberon_item_t *
 306 oberon_factor(oberon_context_t * ctx)
 307 {
 308         char * name;
 309         oberon_var_t * var;
 310
 311         oberon_item_t * item = malloc(sizeof *item);
 312         memset(item, 0, sizeof *item);
 313
 314         switch(ctx -> token)
 315         {
 316                 case IDENT:
 317                         name = oberon_assert_ident(ctx);
 318                         var = oberon_find_var(ctx, name);
 319                         if(var == NULL)
 320                         {
 321                                 oberon_error(ctx, "undefined variable %s", name);
 322                         }
 323                         item -> mode = MODE_VAR;
 324                         item -> var = var;
 325                         break;
 326                 case INTEGER:
 327                         item -> mode = MODE_INTEGER;
 328                         item -> integer = ctx -> integer;
 329                         oberon_assert_token(ctx, INTEGER);
 330                         break;
 331                 case TRUE:
 332                         item -> mode = MODE_BOOLEAN;
 333                         item -> boolean = 1;
 334                         oberon_assert_token(ctx, TRUE);
 335                         break;
 336                 case FALSE:
 337                         item -> mode = MODE_BOOLEAN;
 338                         item -> boolean = 0;
 339                         oberon_assert_token(ctx, FALSE);
 340                         break;
 341                 case LPAREN:
 342                         oberon_assert_token(ctx, LPAREN);
 343                         item = oberon_expr(ctx);
 344                         oberon_assert_token(ctx, RPAREN);
 345                         break;
 346                 default:
 347                         oberon_error(ctx, "invalid expression");
 348         }
 349
 350         return item;
 351 }
 352
 353 static oberon_item_t *
 354 oberon_expr(oberon_context_t * ctx)
 355 {
 356         return oberon_factor(ctx);
 357 }
 358
 359 // =======================================================================
 360 //   PARSER
 361 // =======================================================================
 362
 363 static void
 364 oberon_expect_token(oberon_context_t * ctx, int token)
 365 {
 366         if(ctx -> token != token)
 367         {
 368                 oberon_error(ctx, "unexpected token %i (%i)", ctx -> token, token);
 369         }
 370 }
 371
 372 static void
 373 oberon_assert_token(oberon_context_t * ctx, int token)
 374 {
 375         oberon_expect_token(ctx, token);
 376         oberon_read_token(ctx);
 377 }
 378
 379 static char *
 380 oberon_assert_ident(oberon_context_t * ctx)
 381 {
 382         oberon_expect_token(ctx, IDENT);
 383         char * ident = ctx -> string;
 384         oberon_read_token(ctx);
 385         return ident;
 386 }
 387
 388 static oberon_type_t *
 389 oberon_type(oberon_context_t * ctx)
 390 {
 391         char * name = oberon_assert_ident(ctx);
 392         oberon_type_t * type = oberon_find_type(ctx, name);
 393
 394         if(type == NULL)
 395         {
 396                 oberon_error(ctx, "undefined type");
 397         }
 398
 399         return type;
 400 }
 401
 402 static void
 403 oberon_var_decl(oberon_context_t * ctx)
 404 {
 405         char * name = oberon_assert_ident(ctx);
 406         oberon_assert_token(ctx, COLON);
 407         oberon_type_t * type = oberon_type(ctx);
 408         oberon_define_var(ctx, name, type);
 409 }
 410
 411 static void
 412 oberon_decl_seq(oberon_context_t * ctx)
 413 {
 414         if(ctx -> token == VAR)
 415         {
 416                 oberon_assert_token(ctx, VAR);
 417                 while(ctx -> token == IDENT)
 418                 {
 419                         oberon_var_decl(ctx);
 420                         oberon_assert_token(ctx, SEMICOLON);
 421                 }
 422         }
 423 }
 424
 425 static void
 426 oberon_assign(oberon_context_t * ctx, oberon_item_t * src, oberon_item_t * dst)
 427 {
 428         if(dst -> mode == MODE_INTEGER)
 429         {
 430                 oberon_error(ctx, "invalid assignment");
 431         }
 432
 433         oberon_autocast_to(ctx, src, dst);
 434
 435         oberon_generate_assign(ctx, src, dst);
 436 }
 437
 438 static void
 439 oberon_statement(oberon_context_t * ctx)
 440 {
 441         oberon_item_t * item1;
 442         oberon_item_t * item2;
 443
 444         if(ctx -> token == IDENT)
 445         {
 446                 item1 = oberon_expr(ctx);
 447                 oberon_assert_token(ctx, ASSIGN);
 448                 item2 = oberon_expr(ctx);
 449                 oberon_assign(ctx, item2, item1);
 450         }
 451 }
 452
 453 static void
 454 oberon_statement_seq(oberon_context_t * ctx)
 455 {
 456         oberon_statement(ctx);
 457         while(ctx -> token == SEMICOLON)
 458         {
 459                 oberon_assert_token(ctx, SEMICOLON);
 460                 oberon_statement(ctx);
 461         }
 462 }
 463
 464 static void
 465 oberon_parse_module(oberon_context_t * ctx)
 466 {
 467         char *name1, *name2;
 468         oberon_read_token(ctx);
 469
 470         oberon_assert_token(ctx, MODULE);
 471         name1 = oberon_assert_ident(ctx);
 472         oberon_assert_token(ctx, SEMICOLON);
 473         ctx -> mod -> name = name1;
 474
 475         oberon_decl_seq(ctx);
 476
 477         if(ctx -> token == BEGIN)
 478         {
 479                 oberon_assert_token(ctx, BEGIN);
 480                 oberon_generate_begin_module(ctx);
 481                 oberon_statement_seq(ctx);
 482                 oberon_generate_end_module(ctx);
 483         }
 484
 485         oberon_assert_token(ctx, END);
 486         name2 = oberon_assert_ident(ctx);
 487         oberon_assert_token(ctx, DOT);
 488
 489         if(strcmp(name1, name2) != 0)
 490         {
 491                 oberon_error(ctx, "module name not matched");
 492         }
 493 }
 494
 495 // =======================================================================
 496 //   LIBRARY
 497 // =======================================================================
 498
 499 oberon_context_t *
 500 oberon_create_context()
 501 {
 502         oberon_context_t * ctx = malloc(sizeof *ctx);
 503         memset(ctx, 0, sizeof *ctx);
 504
 505         oberon_type_t * types = malloc(sizeof *types);
 506         memset(types, 0, sizeof *types);
 507
 508         oberon_generator_init_context(ctx);
 509         ctx -> types = types;
 510         return ctx;
 511 }
 512
 513 void
 514 oberon_destroy_context(oberon_context_t * ctx)
 515 {
 516         oberon_generator_destroy_context(ctx);
 517         free(ctx);
 518 }
 519
 520 oberon_module_t *
 521 oberon_compile_module(oberon_context_t * ctx, const char * code)
 522 {
 523         oberon_module_t * mod = malloc(sizeof *mod);
 524         memset(mod, 0, sizeof *mod);
 525         oberon_var_t * vars = malloc(sizeof *vars);
 526         memset(vars, 0, sizeof *vars);
 527         ctx -> mod = mod;
 528         ctx -> mod -> vars = vars;
 529
 530         oberon_init_scaner(ctx, code);
 531         oberon_parse_module(ctx);
 532
 533         oberon_generate_code(ctx);
 534         return mod;
 535 }
 536
 537 void
 538 oberon_register_global_type(oberon_context_t * ctx, oberon_type_t * type)
 539 {
 540         oberon_type_t * x = ctx -> types;
 541         while(x -> next && strcmp(x -> next -> name, type -> name) != 0)
 542         {
 543                 x = x -> next;
 544         }
 545
 546         if(x -> next)
 547         {
 548                 oberon_error(ctx, "already defined");
 549         }
 550
 551         // TODO: copy type name (not a pointer)
 552         oberon_type_t * newtype = malloc(sizeof *newtype);
 553         memcpy(newtype, type, sizeof *newtype);
 554         newtype -> next = NULL;
 555         oberon_generator_init_type(ctx, newtype);
 556
 557         x -> next = newtype;
 558 }