src/test.c

   1 #include <stdio.h>
   2 #include <string.h>
   3 #include <assert.h>
   4
   5 #include "../include/oberon.h"
   6
   7 static char source_test[] =
   8         "(* Main module *)"
   9         "MODULE Test;"
  10         "IMPORT Out;"
  11         ""
  12         "TYPE"
  13         "  R = INTEGER;"
  14         ""
  15         "PROCEDURE Factorial(n : R) : R;"
  16         "BEGIN"
  17         "  IF n <= 1 THEN"
  18         "    RETURN 1;"
  19         "  ELSE"
  20         "    RETURN n * Factorial(n - 1);"
  21         "  END;"
  22         "  RETURN 0; (* Детектор ретурнов - дерьмо *)"
  23         "END Factorial;"
  24         ""
  25         "BEGIN"
  26         "  Out.Open();"
  27         "  Out.Int(Factorial(0), 0); Out.Ln;"
  28         "  Out.Int(Factorial(1), 0); Out.Ln;"
  29         "  Out.Int(Factorial(2), 0); Out.Ln;"
  30         "  Out.Int(Factorial(3), 0); Out.Ln;"
  31         "  Out.Int(Factorial(4), 0); Out.Ln;"
  32         "  Out.Int(Factorial(5), 0); Out.Ln;"
  33         "  Out.Int(Factorial(6), 0); Out.Ln;"
  34         "  Out.Int(Factorial(7), 0); Out.Ln;"
  35         "  Out.Int(Factorial(8), 0); Out.Ln;"
  36         "  Out.Int(Factorial(9), 0); Out.Ln;"
  37         "  Out.Int(Factorial(10), 0); Out.Ln;"
  38         "  Out.Int(Factorial(11), 0); Out.Ln;"
  39         "  Out.Int(Factorial(12), 0); Out.Ln;"
  40         "  Out.Int(Factorial(13), 0); Out.Ln;"
  41         "  Out.Int(Factorial(14), 0); Out.Ln;"
  42         "END Test."
  43 ;
  44
  45 static char source_out[] =
  46         "MODULE Out;"
  47         "  PROCEDURE Open*;"
  48         "  END Open;"
  49         ""
  50         "  PROCEDURE Char* (ch : CHAR);"
  51         "  END Char;"
  52         ""
  53         "  PROCEDURE String* (str : ARRAY OF CHAR);"
  54         "  END String;"
  55         ""
  56         "  PROCEDURE Int*(i, n : LONGINT);"
  57         "  END Int;"
  58         ""
  59         "  PROCEDURE Real*(x : REAL; n : INTEGER);"
  60         "  END Real;"
  61         ""
  62         "  PROCEDURE LongReal*(x : LONGREAL; n : INTEGER);"
  63         "  END LongReal;"
  64         ""
  65         "  PROCEDURE Ln*;"
  66         "  END Ln;"
  67         ""
  68         "END Out."
  69 ;
  70
  71 static oberon_context_t * ctx;
  72 static oberon_module_t * mod;
  73
  74 static const char *
  75 import_module(const char * name)
  76 {
  77         if(strcmp(name, "Test") == 0)
  78         {
  79                 return source_test;
  80         }
  81         else if(strcmp(name, "Out") == 0)
  82         {
  83                 return source_out;
  84         }
  85         else
  86         {
  87                 return NULL;
  88         }
  89 }
  90
  91 typedef void (*TOutOpen)();
  92 static TOutOpen * OutOpenPtr;
  93 void ImplOutOpen()
  94 {
  95 }
  96
  97 typedef void (*TOutInt)(int, int);
  98 static TOutInt * OutIntPtr;
  99 void ImplOutInt(int i, int n)
 100 {
 101         char number[22];
 102         snprintf(number, 22, "%d", i);
 103         int len = strlen(number);
 104         for(int i = 0; i < n - len; i++)
 105         {
 106                 putchar(' ');
 107         }
 108         printf("%s", number);
 109 }
 110
 111 typedef void (*TOutReal)(float, int);
 112 static TOutReal * OutRealPtr;
 113 void ImplOutReal(float i, int n)
 114 {
 115         char number[32];
 116         snprintf(number, 32, "%F", i);
 117         int len = strlen(number);
 118         for(int i = 0; i < n - len; i++)
 119         {
 120                 putchar(' ');
 121         }
 122         printf("%s", number);
 123 }
 124
 125 typedef void (*TOutLn)();
 126 static TOutLn * OutLnPtr;
 127 void ImplOutLn()
 128 {
 129         putchar('\n');
 130 }
 131
 132 void init_system_modules()
 133 {
 134         OutOpenPtr = oberon_generator_get_var(ctx, "Out_Open");
 135         *OutOpenPtr = ImplOutOpen;
 136         OutIntPtr = oberon_generator_get_var(ctx, "Out_Int");
 137         *OutIntPtr = ImplOutInt;
 138         OutRealPtr = oberon_generator_get_var(ctx, "Out_Real");
 139         *OutRealPtr = ImplOutReal;
 140         OutLnPtr = oberon_generator_get_var(ctx, "Out_Ln");
 141         *OutLnPtr = ImplOutLn;
 142 }
 143
 144 void start_module()
 145 {
 146         void (*begin)() = oberon_generator_get_procedure(ctx, "Test_BEGIN");
 147         begin();
 148 }
 149
 150 int
 151 main(int argc, char ** argv)
 152 {
 153         ctx = oberon_create_context(import_module);
 154         mod = oberon_compile_module(ctx, source_test);
 155
 156         oberon_generate_code(ctx);
 157
 158 //      init_system_modules();
 159
 160 //      oberon_generator_dump(ctx, "dump.txt");
 161
 162 //      start_module();
 163
 164         oberon_destroy_context(ctx);
 165         return 0;
 166 }