upd

qic.c

@@ -280,6 +280,7 @@ typedef struct {
 
     T_VAR,
     T_LET,
+    T_CONST,
     T_IF,
     T_ELSE,
     T_ELIF,
@@ -300,6 +301,7 @@ typedef struct {
     T_CATCH,
     T_THROW,
     T_GOTO,
+    T_CLASS,
     T_IS,
     T_IN,
 
@@ -561,6 +563,8 @@ token_t *next_token(char *source, size_t *pos) {
       return TK(VAR);
     else if (strcmp(name, "let") == 0)
       return TK(LET);
+    else if (strcmp(name, "const") == 0)
+      return TK(CONST);
     else if (strcmp(name, "if") == 0)
       return TK(IF);
     else if (strcmp(name, "else") == 0)
@@ -599,6 +603,8 @@ token_t *next_token(char *source, size_t *pos) {
       return TK(THROW);
     else if (strcmp(name, "goto") == 0)
       return TK(GOTO);
+    else if (strcmp(name, "class") == 0)
+      return TK(CLASS);
     else if (strcmp(name, "is") == 0)
       return TK(IS);
     else if (strcmp(name, "in") == 0)
@@ -721,6 +727,7 @@ list_t *tokenize(char *source) {
 
 struct _node_t {
   enum {
+    N_TOPLEVEL,
     N_PROGRAM,
     N_EXPRSTMT,
 
@@ -779,10 +786,12 @@ struct _node_t {
 
     N_VAR,
     N_LET,
+    N_CONST,
     N_IF,
     N_SWITCH,
     N_FOR,
     N_FOROF,
+    N_FOROFVAR,
     N_BREAK,
     N_CONTINUE,
     N_FUNCDEF,
@@ -794,6 +803,7 @@ struct _node_t {
     N_THROW,
     N_LABEL,
     N_GOTO,
+    N_CLASS,
 
     N_INLINE,
 
@@ -850,6 +860,18 @@ node_t *nodel(int tag, list_t *l) {
 
 #define NODEL(n, a) (node_pos(nodel(N_##n, (a)), ((token_t *)tokens->data[(*pos)>0?(*pos)-1:(*pos)])->fi, ((token_t *)tokens->data[(*pos)>0?(*pos)-1:(*pos)])->pos))
 
+node_t *nodetl(int tag, token_t *t, list_t *l) {
+  node_t *node = malloc(sizeof(node_t));
+
+  node->tag = tag;
+  node->t = t;
+  node->l = l;
+
+  return node;
+}
+
+#define NODETL(n, t, l) (node_pos(nodetl(N_##n, (t), (l)), ((token_t *)tokens->data[(*pos)>0?(*pos)-1:(*pos)])->fi, ((token_t *)tokens->data[(*pos)>0?(*pos)-1:(*pos)])->pos))
+
 node_t *nodeh(int tag, table_t *h) {
   node_t *node = malloc(sizeof(node_t));
 
@@ -1570,7 +1592,7 @@ node_t *parse_func(list_t *tokens, size_t *pos, int is_expr) {
   table_t *captured = NULL;
 
   if (MATCH(USE)) {
-    EXPECT(RPAR, "(");
+    EXPECT(LPAR, "(");
 
     captured = table_new();
 
@@ -1618,7 +1640,30 @@ node_t *parse_stmt(list_t *tokens, size_t *pos) {
     return parse_var(tokens, pos, 0);
   else if (MATCH(LET))
     return parse_var(tokens, pos, 1);
-  else if (MATCH(IF))
+  else if (MATCH(CONST)) {
+    table_t *h = table_new();
+
+    do {
+      if(!AT(NAME))
+        PARSE_ERROR("expected identifier");
+
+      char *k = ((token_t *)tokens->data[(*pos)++])->text;
+
+      if (!(k[0] >= 'A' && k[0] <= 'Z'))
+        PARSE_ERROR("compile-time constant identifiers must begin with an uppercase letter, but '%s' does not", k);
+
+      if (table_get(h, k))
+        PARSE_ERROR("duplicated compile-time constant definition: '%s'", k);
+
+      EXPECT(ASSIGN, "=");
+
+      node_t *v = parse_expr(tokens, pos);
+
+      table_set(h, k, v);
+    } while (MATCH(COMMA));
+
+    return NODEH(CONST, h);
+  } else if (MATCH(IF))
     return parse_if(tokens, pos);
   else if (MATCH(SWITCH)) {
     node_t *a = parse_expr(tokens, pos);
@@ -1673,6 +1718,17 @@ node_t *parse_stmt(list_t *tokens, size_t *pos) {
     node_t *c = NULL;
 
     if (!AT(LCB) && !AT(COLON) && !CLIFF) {
+      if (AT(NAME) && ATP(OF, 1)) {
+        token_t *t = tokens->data[(*pos)++];
+
+        EXPECT(OF, "of");
+
+        a = parse_expr(tokens, pos);
+        b = BLOCK();
+
+        return NODE2t(FOROF, a, b, t);
+      }
+
       if (MATCH(VAR)) {
         if (AT(NAME) && ATP(OF, 1)) {
           token_t *t = tokens->data[(*pos)++];
@@ -1682,7 +1738,7 @@ node_t *parse_stmt(list_t *tokens, size_t *pos) {
           a = parse_expr(tokens, pos);
           b = BLOCK();
 
-          return NODE2t(FOROF, a, b, t);
+          return NODE2t(FOROFVAR, a, b, t);
         }
 
         a = parse_var(tokens, pos, 0);
@@ -1752,6 +1808,60 @@ node_t *parse_stmt(list_t *tokens, size_t *pos) {
     EXPECT(COLON, ":");
 
     return NODET(LABEL, t);
+  } else if (MATCH(CLASS)) {
+    if(!AT(NAME))
+      PARSE_ERROR("expected identifier");
+
+    token_t *t = tokens->data[(*pos)++];
+
+    list_t *l = NULL;
+
+    if (MATCH(LPAR)) {
+      l = list_new();
+
+      do {
+        if(!AT(NAME))
+          PARSE_ERROR("expected identifier");
+
+        token_t *t = tokens->data[(*pos)++];
+
+        list_push(l, t);
+      } while (MATCH(COMMA));
+
+      EXPECT(RPAR, ")");
+    }
+
+    EXPECT(LCB, "{");
+
+    list_t *triples = list_new();
+
+    for (;;) {
+      if (!AT(NAME))
+        break;
+
+      list_t *triple = list_new();
+
+      token_t *t = tokens->data[(*pos)++];
+      list_push(triple, t);
+
+      if (MATCH(ASSIGN)) {
+        list_push(triple, t);
+        list_push(triple, parse_expr(tokens, pos));
+      } else {
+        list_push(triple, NULL);
+        list_push(triple, parse_func(tokens, pos, 1));
+      }
+
+      list_push(triples, triple);
+    }
+
+    EXPECT(RCB, "}");
+
+    list_t *pair = list_new();
+    list_push(pair, l);
+    list_push(pair, triples);
+
+    return NODETL(CLASS, t, pair);
   } else if (MATCH(INLINE)) {
     if (!AT(STRING))
       PARSE_ERROR("expected string");
@@ -1794,7 +1904,7 @@ node_t *parse_program(list_t *tokens, size_t *pos) {
     list_push(stmts, n);
   }
 
-  return NODEL(PROGRAM, stmts);
+  return NODEL(TOPLEVEL, stmts);
 }
 
 node_t *parse(char *source) {
@@ -1955,7 +2065,7 @@ char *tempvar() {
   return s;
 }
 
-void compile_func(buffer_t *gbuf, buffer_t *buf, list_t *ctx, stack_t *lstk, list_t *lbl, node_t *node) {
+void compile_func(buffer_t *gbuf, buffer_t *buf, list_t *ctx, stack_t *lstk, list_t *lbl, node_t *node, char *name) {
   NEWGID();
 
   buffer_t *tbuf = buffer_new();
@@ -2000,7 +2110,7 @@ void compile_func(buffer_t *gbuf, buffer_t *buf, list_t *ctx, stack_t *lstk, lis
 
   tbuf = buffer_new();
 
-  buffer_fmt(tbuf, "qi_make_function(state, \"%s\", %d, __func%d, ", node->t? node->t->text: "<anon>", !node->h? 0: (node->h->used - optargc), gid);
+  buffer_fmt(tbuf, "qi_make_function(state, \"%s\", %d, __func%d, ", name? name: node->t? node->t->text: "<anon>", !node->h? 0: (node->h->used - optargc), gid);
   compile_table(gbuf, tbuf, ctx, lstk, lbl, node->h2);
   buffer_fmt(tbuf, ")");
 
@@ -2015,14 +2125,77 @@ void compile_func(buffer_t *gbuf, buffer_t *buf, list_t *ctx, stack_t *lstk, lis
   EMIT(");");
 }
 
-void compile_block(buffer_t *gbuf, buffer_t *buf, list_t *ctx, stack_t *lstk, list_t *lbl, list_t *block) {
+table_t *CONSTANTS;
+
+void compile_block(buffer_t *gbuf, buffer_t *buf, list_t *ctx, stack_t *lstk, list_t *lbl, list_t *block, int toplevel) {
   for (size_t i = 0; i < block->length; i++) {
     node_t *node = block->data[i];
 
-    if (node->tag == N_FUNCDEF) {
-      compile_func(gbuf, buf, ctx, lstk, lbl, node);
+    if (node->tag == N_CONST) {
+      if (!toplevel)
+        COMPILE_ERROR("const is not on top-level")
+
+      table_iterate(node->h, {
+        char *name = entry.key;
+
+        if (table_get(CONSTANTS, name))
+          COMPILE_ERROR("redeclaration of compile-time constant: '%s'", name);
+
+        table_set(CONSTANTS, name, entry.value);
+      });
+    } else if (node->tag == N_FUNCDEF) {
+      compile_func(gbuf, buf, ctx, lstk, lbl, node, NULL);
 
       EMIT("\n");
+    } else if (node->tag == N_CLASS) {
+      NEWGID();
+
+      char *name = node->t->text;
+      list_t *supers = list_index(node->l, 0);
+      list_t *triples = list_index(node->l, 1);
+
+      buffer_t *tbuf = buffer_new();
+
+      buffer_fmt(tbuf, "qi_value_t *__class%d(qi_state_t *state) {\n", gid);
+      buffer_fmt(tbuf, "qi_list_t *supers = qi_list_make_n(%d);\n", !supers? 0: supers->length);
+
+      if (supers)
+        for (size_t i = 0; i < supers->length; i++) {
+          token_t *t = supers->data[i];
+
+          buffer_fmt(tbuf, "qi_list_data(supers, %d) = qi_get(state, \"%s\");\n", i, t->text);        
+        }
+
+      buffer_fmt(tbuf, "qi_table_t *table = qi_table_make();\n");
+      buffer_fmt(tbuf, "qi_table_t *metatable = qi_table_make();\n");
+
+      for (size_t i = 0; i < triples->length; i++) {
+        list_t *triple = triples->data[i];
+        token_t *t = triple->data[0];
+
+        buffer_t *methodname = buffer_new();
+        buffer_fmt(methodname, "%s.%s", name, t->text);
+
+        buffer_fmt(tbuf, "qi_table_set(%s, \"%s\", ", triple->data[1] != NULL? "table": "metatable", t->text);
+        if (triple->data[1] == NULL)
+          compile_func(gbuf, tbuf, ctx, lstk, lbl, triple->data[2], buffer_read(methodname));
+        else
+          compile_node(gbuf, tbuf, ctx, lstk, lbl, triple->data[2]);
+        buffer_fmt(tbuf, ");\n");
+      }
+
+      buffer_fmt(tbuf, "qi_list_t *pargs = qi_list_make_n(4);\n");
+      buffer_fmt(tbuf, "qi_list_data(pargs, 0) = qi_make_string(state, \"%s\");\n", name);
+      buffer_fmt(tbuf, "qi_list_data(pargs, 1) = qi_make_list(state, supers);\n");
+      buffer_fmt(tbuf, "qi_list_data(pargs, 2) = qi_make_table(state, table);\n");
+      buffer_fmt(tbuf, "qi_list_data(pargs, 3) = qi_make_table(state, metatable);\n");
+
+      buffer_fmt(tbuf, "return qi_call(state, qi_get(state, \"__class_wrapper\"), pargs);\n");
+      buffer_fmt(tbuf, "}\n");
+
+      buffer_appendb(gbuf, tbuf);
+
+      EMIT("qi_set(state, false, \"%s\", __class%d(state));", name, gid);
     } else if (node->tag == N_LABEL) {
       char *label = node->t->text;
 
@@ -2058,11 +2231,12 @@ const char *STD[][2] = {
     "  inline `exit(code)`\n"
     "}\n"
     "func head(l): return l[0]\n"
+    "func tail(l): return slice(l, 1)\n"
     "func die(msg, c=1) {\n"
     "  println(msg)\n"
     "  exit(c)\n"
     "}\n"
-    "let SEEK_SET = 0, SEEK_CUR = 1, SEEK_END = 2\n"
+    "const SEEK_SET = 0, SEEK_CUR = 1, SEEK_END = 2\n"
     "func frewind(file)\n"
     "  return file.rewind()\n"
     "func file_read(filename) {\n"
@@ -2145,6 +2319,33 @@ const char *STD[][2] = {
     "set_pseudomethod(\"list.slice\", slice)\n"
     "set_pseudomethod(\"string.slice\", slice)\n"
     "set_pseudomethod(\"bytes.slice\", slice)\n"
+    "func Object(t, p=nil): return p !is nil? set_meta_table(p, get_meta_table(p) + t): set_meta_table({}, t)\n"
+    "func __class_wrapper(n, p, t, mt): return Object({\n"
+    "    t: t,\n"
+    "    mt: mt,\n"
+    "    super: [],\n"
+    "    __type: func (this) use (n): return n,\n"
+    "    __str: func (this) use (n): return \"<class \" + n + \">\",\n"
+    "    __call: func (this, pargs) use (p) {\n"
+    "        var t = {}\n"
+    "        var mt = {}\n"
+    "        for var other of p {\n"
+    "            t += other.t\n"
+    "            mt += other.mt\n"
+    "            list_push(this.super, other)\n"
+    "        }\n"
+    "        if len(this.super) == 1\n"
+    "          this.super = this.super[0]\n"
+    "        t += this.t\n"
+    "        mt += this.mt\n"
+    "        t.super = this.super\n"
+    "        obj = set_meta_table(t, mt)\n"
+    "        if \"constructor\" in mt\n"
+    "          func_call(mt.constructor, [obj] + pargs)\n"
+    "        return obj\n"
+    "    }\n"
+    "})\n"
+    "inline `srand(time(NULL))`\n"
   },
 
   {"str",
@@ -2238,8 +2439,8 @@ int require_once(buffer_t *gbuf, buffer_t *buf, list_t *ctx, stack_t *lstk, list
 
 void compile_node(buffer_t *gbuf, buffer_t *buf, list_t *ctx, stack_t *lstk, list_t *lbl, node_t *node) {
   switch (node->tag) {
-    case N_PROGRAM:
-      compile_block(gbuf, buf, ctx, lstk, lbl, node->l);
+    case N_TOPLEVEL: case N_PROGRAM:
+      compile_block(gbuf, buf, ctx, lstk, lbl, node->l, node->tag == N_TOPLEVEL);
       break;
 
     case N_EXPRSTMT:
@@ -2252,7 +2453,7 @@ void compile_node(buffer_t *gbuf, buffer_t *buf, list_t *ctx, stack_t *lstk, lis
       LBPUSH();
       CTXPUSH("scope");
       EMIT("qi_new_scope(state);\n");
-      compile_block(gbuf, buf, ctx, lstk, lbl, node->l);
+      compile_block(gbuf, buf, ctx, lstk, lbl, node->l, 0);
       EMIT("qi_old_scope(state);");
       CTXPOP();
       LBPOP();
@@ -2272,9 +2473,15 @@ void compile_node(buffer_t *gbuf, buffer_t *buf, list_t *ctx, stack_t *lstk, lis
           }
           break;
 
-        case T_NAME:
-          EMIT("qi_get(state, \"%s\")", node->t->text);
-          break;
+        case T_NAME: {
+          char *name = node->t->text;
+          node_t *n = table_get(CONSTANTS, name);
+
+          if (n)
+            compile_node(gbuf, buf, ctx, lstk, lbl, n);
+          else
+            EMIT("qi_get(state, \"%s\")", name);
+          } break;
 
         default:
           COMPILE_ERROR("not yet implemented");
@@ -2353,6 +2560,8 @@ void compile_node(buffer_t *gbuf, buffer_t *buf, list_t *ctx, stack_t *lstk, lis
       });
     break;
 
+    case N_CONST:break;
+
     case N_IF:
       EMIT("if (_qi_truthy(state, ");
       compile_node(gbuf, buf, ctx, lstk, lbl, node->a);
@@ -2444,7 +2653,7 @@ void compile_node(buffer_t *gbuf, buffer_t *buf, list_t *ctx, stack_t *lstk, lis
       EMIT("__break%d:;\n", gid);
       } break;
 
-    case N_FOROF: {
+    case N_FOROF: case N_FOROFVAR: {
       NEWGID();
       char *varname = tempvar();
 
@@ -2452,10 +2661,8 @@ void compile_node(buffer_t *gbuf, buffer_t *buf, list_t *ctx, stack_t *lstk, lis
       compile_node(gbuf, buf, ctx, lstk, lbl, node->a);
       EMIT(");\n");
 
-      CTXPUSH("scope");
-      EMIT("qi_new_scope(state);\n");
-
-      EMIT("qi_decl(state, \"%s\", state->nil);\n", node->t->text);
+      if (node->tag == N_FOROFVAR)
+        EMIT("qi_decl(state, \"%s\", state->nil);\n", node->t->text);
 
       EMIT("for (qi_size_t length = _qi_length(state, %s), i = 0; i < length; i++) {\n", varname);
       EMIT("qi_set(state, false, \"%s\", qi_index(state, %s, qi_make_number(state, i)));\n", node->t->text, varname);
@@ -2470,9 +2677,6 @@ void compile_node(buffer_t *gbuf, buffer_t *buf, list_t *ctx, stack_t *lstk, lis
       EMIT("}\n");
 
       EMIT("__break%d:;\n", gid);
-
-      EMIT("qi_old_scope(state);");
-      CTXPOP();
       } break;
 
     case N_BREAK:
@@ -2530,6 +2734,7 @@ void compile_node(buffer_t *gbuf, buffer_t *buf, list_t *ctx, stack_t *lstk, lis
       break;
 
     case N_FUNCDEF: break;
+    case N_CLASS: break;
     case N_PASS: break;
 
     case N_TRY:
@@ -2587,7 +2792,7 @@ void compile_node(buffer_t *gbuf, buffer_t *buf, list_t *ctx, stack_t *lstk, lis
       break;
 
     case N_FUNCEXPR:
-      compile_func(gbuf, buf, ctx, lstk, lbl, node);
+      compile_func(gbuf, buf, ctx, lstk, lbl, node, NULL);
       break;
 
     case N_EQUALS:
@@ -2772,6 +2977,7 @@ char *compile_file(char *filename, FILE *fd) {
 int main(int argc, char **argv) {
   FILES = list_new();
   REQUIRED = list_new();
+  CONSTANTS = table_new();
 
   char *out = compile_file("<stdin>", stdin);