shithub: mc

--- a/8/isel.c

+++ b/8/isel.c

@@ -769,6 +769,10 @@

                         fprintf(fd, "%s:\n", lbl);

                         writeblob(fd, v->lit.strval, strlen(v->lit.strval));

                         break;

+        case Ltup:

+            for (i = 0; i < v->lit.nelt; i++)

+                writelit(fd, v->lit.tupval[i]->expr.args[0]);

+            break;

         case Lseq:

             for (i = 0; i < v->lit.nelt; i++)

                 writelit(fd, v->lit.seqval[i]->expr.args[0]);

--- a/8/simp.c

+++ b/8/simp.c

@@ -845,7 +845,7 @@

                 case Lchr: case Lbool: case Lint:

                     r = n;

                     break;

-                case Lstr: case Lseq: case Lflt:

+                case Lstr: case Lseq: case Ltup: case Lflt:

                     r = bloblit(s, n);

                     break;

                 case Lfunc:

--- a/parse/dump.c

+++ b/parse/dump.c

@@ -178,7 +178,11 @@

                     for (i = 0; i < n->lit.nelt; i++)

                         outnode(n->lit.seqval[i], fd, depth+1);

                     break;

-                default: die("Bad literal type"); break;

+                case Ltup:

+                    fprintf(fd, " Ltup\n");

+                    for (i = 0; i < n->lit.nelt; i++)

+                        outnode(n->lit.tupval[i], fd, depth+1);

+                    break;

             break;

         case Nfunc:

--- a/parse/gram.y

+++ b/parse/gram.y

@@ -117,8 +117,9 @@

 %start module

-%type <ty> type structdef uniondef compoundtype functype funcsig

+%type <ty> type structdef uniondef tupledef compoundtype functype funcsig

 %type <ty> generictype

+%type <tylist> tuptybody

 %type <tok> asnop cmpop addop mulop shiftop

@@ -127,14 +128,15 @@

 %type <node> exprln retexpr expr atomicexpr littok literal asnexpr lorexpr landexpr borexpr

 %type <node> bandexpr cmpexpr unionexpr addexpr mulexpr shiftexpr prefixexpr postfixexpr

 %type <node> funclit seqlit name block blockbody stmt label use

-%type <node> decl declbody declcore structelt seqelt

+%type <node> decl declbody declcore structelt seqelt tuphead

 %type <node> ifstmt forstmt whilestmt matchstmt elifs optexprln

 %type <node> pat unionpat match

 %type <node> castexpr

 %type <ucon> unionelt

-%type <nodelist> arglist argdefs structbody params matches seqbody

-%type <uconlist> unionbody

+%type <nodelist> arglist argdefs params matches

+%type <nodelist> structbody seqbody tupbody tuprest

+%type <uconlist> unionbody

 %union {

     struct {

@@ -176,6 +178,7 @@

 toplev

         : decl

             {lappend(&file->file.stmts, &file->file.nstmts, $1);

+             $1->decl.isglobl = 1;

              putdcl(file->file.globls, $1);}

         | use

             {lappend(&file->file.uses, &file->file.nuses, $1);}

@@ -224,7 +227,7 @@

 pkgitem : decl

             {putdcl(file->file.exports, $1);

-            if ($1->decl.init)

+             if ($1->decl.init)

                  lappend(&file->file.stmts, &file->file.nstmts, $1);}

         | tydef {puttype(file->file.exports, mkname($1.line, $1.name), $1.type);}

         | visdef {die("Unimplemented visdef");}

@@ -263,6 +266,7 @@

 type    : structdef

+        | tupledef

         | uniondef

         | compoundtype

         | generictype

@@ -304,6 +308,18 @@

              $$.nn = 0;}

+tupledef: Tosqbrac tuptybody Tcsqbrac

+            {$$ = mktytuple($1->line, $2.types, $2.ntypes);}

+        ;

+tuptybody

+        : type

+            {$$.types = NULL; $$.ntypes = 0;

+             lappend(&$$.types, &$$.ntypes, $1);}

+        | tuptybody Tcomma type

+            {lappend(&$$.types, &$$.ntypes, $3);}

+        ;

 structdef

         : Tstruct structbody Tendblk

             {$$ = mktystruct($1->line, $2.nl, $2.nn);}

@@ -488,10 +504,26 @@

         | literal {$$ = mkexpr($1->line, Olit, $1, NULL);}

         | Toparen expr Tcparen

             {$$ = $2;}

+        | Toparen tupbody Tcparen

+            {$$ = mkexpr($1->line, Olit, mktuple($1->line, $2.nl, $2.nn), NULL);}

         | Tsizeof Toparen type Tcparen

             {$$ = mkexpr($1->line, Osize, mkpseudodecl($3), NULL);}

+tupbody : tuphead tuprest

+            {$$ = $2;

+             linsert(&$$.nl, &$$.nn, 0, $1);}

+        ;

+tuphead : expr Tcomma {$$ = $1;}

+        ;

+tuprest : expr

+            {$$.nl = NULL; $$.nn = 0; lappend(&$$.nl, &$$.nn, $1);}

+        | tuprest Tcomma expr

+            {lappend(&$$.nl, &$$.nn, $3);}

+        ;

 literal : funclit       {$$ = $1;}

         | seqlit        {$$ = $1;}

         | littok        {$$ = $1;}

@@ -522,7 +554,8 @@

             {$$ = mkseq($1->line, $2.nl, $2.nn);}

-seqbody : seqelt

+seqbody : /* empty */ {$$.nl = NULL; $$.nn = 0;}

+        | seqelt

             {$$.nl = NULL; $$.nn = 0;

              lappend(&$$.nl, &$$.nn, $1);}

         | seqbody Tcomma seqelt

@@ -533,9 +566,11 @@

             {die("Unimplemented struct member init");}

         | Thash atomicexpr Tasn expr

             {die("Unimplmented array member init");}

-        | expr {$$ = $1;}

-        | Tendln seqelt {$$ = $2;}

-        | seqelt Tendln {$$ = $1;}

+        | endlns expr endlns{$$ = $2;}

+        ;

+endlns  : /* none */

+        | endlns Tendln

 stmt    : decl

--- a/parse/infer.c

+++ b/parse/infer.c

@@ -176,6 +176,7 @@

         case Lstr:      return mktyslice(n->line, mkty(n->line, Tychar));       break;

         case Lfunc:     return n->lit.fnval->func.type;                         break;

         case Lseq:      return NULL; break;

+        case Ltup:      return NULL; break;

};

     die("Bad lit type %d", n->lit.littype);

     return NULL;

@@ -385,6 +386,19 @@

     settype(n, mktyarray(n->line, type(n->lit.seqval[0]), mkintlit(n->line, n->lit.nelt)));

+static void infertup(Node *n)

+{

+    size_t i;

+    Type **t;

+    t = xalloc(sizeof(Type *)*n->lit.nelt);

+    for (i = 0; i < n->lit.nelt; i++) {

+        infernode(n->lit.tupval[i], NULL, NULL);

+        t[i] = type(n->lit.tupval[i]);

+    }

+    settype(n, mktytuple(n->line, t, n->lit.nelt));

+}

 static void inferexpr(Node *n, Type *ret, int *sawret)

     Node **args;

@@ -544,6 +558,7 @@

             switch (args[0]->lit.littype) {

                 case Lfunc:     infernode(args[0]->lit.fnval, NULL, NULL); break;

                 case Lseq:      inferseq(args[0]);                         break;

+                case Ltup:      infertup(args[0]);                         break;

                 default:        /* pass */                                 break;

             settype(n, type(args[0]));

--- a/parse/lits.def

+++ b/parse/lits.def

@@ -5,3 +5,4 @@

 L(Lstr)

 L(Lfunc)

 L(Lseq)

+L(Ltup)

--- a/parse/node.c

+++ b/parse/node.c

@@ -220,6 +220,18 @@

     return n;

+Node *mktuple(int line, Node **vals, size_t nvals)

+{

+    Node *n;

+    n = mknode(line, Nlit);

+    n->lit.littype = Ltup;

+    n->lit.nelt = nvals;

+    n->lit.seqval = vals;

+    return n;

+}

 Node *mkname(int line, char *name)

     Node *n;

--- a/parse/parse.h

+++ b/parse/parse.h

@@ -170,6 +170,7 @@

                 int      boolval;

                 Node    *fnval;

                 Node    **seqval;

+                Node    **tupval;

};

         } lit;

@@ -209,9 +210,10 @@

         struct {

             long  did;

-            int   isconst;

-            int   isgeneric;

-            int   isextern;

+            char  isglobl;

+            char  isconst;

+            char  isgeneric;

+            char  isextern;

             Node *name;

             Type *type;

             Node *init;

@@ -329,6 +331,7 @@

 Type *mktyslice(int line, Type *base);

 Type *mktyidxhack(int line, Type *base);

 Type *mktyptr(int line, Type *base);

+Type *mktytuple(int line, Type **sub, size_t nsub);

 Type *mktyfunc(int line, Node **args, size_t nargs, Type *ret);

 Type *mktystruct(int line, Node **decls, size_t ndecls);

 Type *mktyunion(int line, Ucon **decls, size_t ndecls);

@@ -364,6 +367,7 @@

 Node *mkfloat(int line, double flt);

 Node *mkfunc(int line, Node **args, size_t nargs, Type *ret, Node *body);

 Node *mkseq(int line, Node **vals, size_t nvals);

+Node *mktuple(int line, Node **vals, size_t nvals);

 Node *mkname(int line, char *name);

 Node *mknsname(int line, char *ns, char *name);

 Node *mkdecl(int line, Node *name, Type *ty);

--- a/parse/pickle.c

+++ b/parse/pickle.c

@@ -316,6 +316,10 @@

                     for (i = 0; i < n->lit.nelt; i++)

                         pickle(n->lit.seqval[i], fd);

                     break;

+                case Ltup:

+                    for (i = 0; i < n->lit.nelt; i++)

+                        pickle(n->lit.tupval[i], fd);

+                    break;

             break;

         case Nloopstmt:

@@ -432,6 +436,10 @@

                 case Lseq:

                     for (i = 0; i < n->lit.nelt; i++)

                         n->lit.seqval[i] = unpickle(fd);

+                    break;

+                case Ltup:

+                    for (i = 0; i < n->lit.nelt; i++)

+                        n->lit.tupval[i] = unpickle(fd);

                     break;

             break;

--- a/parse/specialize.c

+++ b/parse/specialize.c

@@ -106,6 +106,10 @@

                     for (i = 0; i < n->lit.nelt; i++)

                         fixup(n->lit.seqval[i]);

                     break;

+                case Ltup:

+                    for (i = 0; i < n->lit.nelt; i++)

+                        fixup(n->lit.tupval[i]);

+                    break;

                 case Lchr: case Lint: case Lflt: case Lstr: case Lbool:

                     break;

@@ -188,6 +192,9 @@

                 case Lseq:

                     for (i = 0; i < n->lit.nelt; i++)

                         r->lit.seqval[i] = specializenode(n->lit.seqval[i], tsmap);

+                case Ltup:

+                    for (i = 0; i < n->lit.nelt; i++)

+                        r->lit.tupval[i] = specializenode(n->lit.tupval[i], tsmap);

                     break;

             break;

--- a/parse/stab.c

+++ b/parse/stab.c

@@ -78,7 +78,7 @@

             /* record that this is in the closure of this scope */

             if (!st->closure)

                 st->closure = mkht(namehash, nameeq);

-            if (st != orig)

+            if (st != orig && !n->decl.isglobl)

                 htput(st->closure, s->decl.name, s);

             return s;

--- a/parse/type.c

+++ b/parse/type.c

@@ -177,6 +177,19 @@

     return t;

+Type *mktytuple(int line, Type **sub, size_t nsub)

+{

+    Type *t;

+    size_t i;

+    t = mkty(line, Tyfunc);

+    t->nsub = nsub;

+    t->sub = xalloc(nsub*sizeof(Type));

+    for (i = 0; i < nsub; i++)

+        t->sub[i] = sub[i];

+    return t;

+}

 Type *mktyfunc(int line, Node **args, size_t nargs, Type *ret)

     Type *t;

--- /dev/null

+++ b/test/closure.myr

@@ -1,0 +1,7 @@

+const main = {

+	var a = 42

+	var f = {b

+		-> a + b

+	}

+	-> f(13)

+}

--- a/test/tests

+++ b/test/tests

@@ -32,6 +32,7 @@

 B voidcall	E	12

 B callbig	E	42

 B nestfn	E	42

+B closure	E	55

 B loop		E	45

 B fib		E	21

 B float		E	1