shithub: mc

--- a/6/isel.c

+++ b/6/isel.c

@@ -14,8 +14,7 @@

 #include "parse.h"

 #include "opt.h"

 #include "asm.h"

-#include "platform.h"

+#include "../config.h"

 /* string tables */

 char *insnfmts[] = {

--- a/6/platform.h

+++ /dev/null

@@ -1,9 +1,0 @@

-#if defined(__APPLE__) && defined(__MACH__)

-/* for OSX */

-#   define Asmcmd "as -g -o %s %s"

-#   define Symprefix "_"

-#else

-/* Default to linux */

-#   define Asmcmd "as -g -o %s %s"

-#   define Symprefix ""

-#endif

--- a/6/simp.c

+++ b/6/simp.c

@@ -12,8 +12,7 @@

 #include "parse.h"

 #include "opt.h"

 #include "asm.h"

-#include "platform.h" /* HACK. We need some platform specific code gen behavior. *sigh.* */

+#include "../config.h"

 /* takes a list of nodes, and reduces it (and it's subnodes) to a list

--- a/configure

+++ b/configure

@@ -37,12 +37,12 @@

 case $OS in

     *Linux*)

         echo '#define Asmcmd "as -g -o %s %s"' >> config.h

-        echo '#define Fprefix ""' >> config.h

+        echo '#define Symprefix ""' >> config.h

         echo 'export SYS=linux' >> config.mk

;;

     *Darwin*)

         echo '#define Asmcmd "as -g -o %s %s"' >> config.h

-        echo '#define Fprefix "_"' >> config.h

+        echo '#define Symprefix "_"' >> config.h

         echo 'export SYS=osx' >> config.mk

;;

     *FreeBSD*)

--- a/libstd/Makefile

+++ b/libstd/Makefile

@@ -43,6 +43,7 @@

     strjoin.myr \

     strsplit.myr \

     strstrip.myr \

+    swap.myr \

     sys.myr \

     try.myr \

     types.myr \

--- /dev/null

+++ b/libstd/swap.myr

@@ -1,0 +1,11 @@

+pkg std =

+	generic swap	: (a : @a#, b : @a# -> void)

+;;

+generic swap = {a : @a#, b : @a#

+	var t

+	t = a#

+	a# = b#

+	b# = t

+}

--- a/parse/infer.c

+++ b/parse/infer.c

@@ -238,7 +238,7 @@

     from = tystr(t);

     tybind(st, t);

     ht = mkht(tyhash, tyeq);

-    t = tyspecialize(t, ht);

+    t = tyspecialize(t, ht, st->delayed);

     htfree(ht);

     tyunbind(st, t);

     if (debugopt['u']) {

@@ -296,7 +296,7 @@

 /* Look up the best type to date in the unification table, returning it */

-static Type *tysearch(Inferstate *st, Type *t)

+Type *tysearch(Type *t)

     Type *lu;

     Stab *ns;

@@ -333,7 +333,7 @@

     Type *t;

     size_t i;

-    t = tysearch(st, orig);

+    t = tysearch(orig);

     st->ingeneric += isgeneric(orig);

     tyresolve(st, t);

     /* If this is an instantiation of a generic type, we want the params to

@@ -1434,7 +1434,7 @@

         checktraits(t->param, n->impl.type);

         ht = mkht(tyhash, tyeq);

         htput(ht, t->param, n->impl.type);

-        ty = tyspecialize(type(st, proto), ht);

+        ty = tyspecialize(type(st, proto), ht, st->delayed);

         htfree(ht);

         inferdecl(st, dcl);

@@ -1480,7 +1480,7 @@

     k = htkeys(s->ty, &n);

     for (i = 0; i < n; i++) {

-        t = tysearch(st, gettype(s, k[i]));

+        t = tysearch(gettype(s, k[i]));

         updatetype(s, k[i], t);

     free(k);

@@ -1624,7 +1624,7 @@

     if (!tyflt)

         tyflt = mktype(-1, Tyfloat64);

-    t = tysearch(st, orig);

+    t = tysearch(orig);

     if (orig->type == Tyvar && hthas(st->delayed, orig)) {

         delayed = htget(st->delayed, orig);

         if (t->type == Tyvar)

@@ -1785,7 +1785,7 @@

     k = htkeys(s->ty, &n);

     for (i = 0; i < n; i++) {

-        t = tysearch(st, gettype(s, k[i]));

+        t = tysearch(gettype(s, k[i]));

         updatetype(s, k[i], t);

         tyfix(st, k[i], t);

--- a/parse/parse.h

+++ b/parse/parse.h

@@ -490,7 +490,7 @@

 /* specialize generics */

 Node *specializedcl(Node *n, Type *to, Node **name);

-Type *tyspecialize(Type *t, Htab *tymap);

+Type *tyspecialize(Type *t, Htab *tymap, Htab *delayed);

 Node *genericname(Node *n, Type *t);

 /* usefiles */

@@ -501,6 +501,7 @@

 /* typechecking/inference */

 void infer(Node *file);

+Type *tysearch(Type *t);

 /* debug */

 void dump(Node *t, FILE *fd);

--- a/parse/specialize.c

+++ b/parse/specialize.c

@@ -31,12 +31,13 @@

  * parameters (type schemes in most literature)

  * replaced with type variables that we can unify

  * against */

-Type *tyspecialize(Type *t, Htab *tsmap)

+Type *tyspecialize(Type *t, Htab *tsmap, Htab *delayed)

     Type *ret, *tmp;

     size_t i;

     Type **subst;

+    t = tysearch(t);

     if (hthas(tsmap, t))

         return htget(tsmap, t);

     switch (t->type) {

@@ -57,11 +58,11 @@

                 addtraits(tmp, subst[i]->traits);

                 htput(tsmap, subst[i], tmp);

-            ret = mktyname(t->line, t->name, t->param, t->nparam, tyspecialize(t->sub[0], tsmap));

+            ret = mktyname(t->line, t->name, t->param, t->nparam, tyspecialize(t->sub[0], tsmap, delayed));

             ret->issynth = 1;

             htput(tsmap, t, ret);

             for (i = 0; i < t->nparam; i++)

-                lappend(&ret->arg, &ret->narg, tyspecialize(subst[i], tsmap));

+                lappend(&ret->arg, &ret->narg, tyspecialize(subst[i], tsmap, delayed));

             break;

         case Tystruct:

             ret = tydup(t);

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

             for (i = 0; i < t->nmemb; i++) {

                 tmp = NULL;

                 if (ret->udecls[i]->etype)

-                    tmp = tyspecialize(t->udecls[i]->etype, tsmap);

+                    tmp = tyspecialize(t->udecls[i]->etype, tsmap, delayed);

                 ret->udecls[i] = mkucon(t->line, t->udecls[i]->name, ret, tmp);

                 ret->udecls[i]->utype = ret;

                 ret->udecls[i]->id = i;

@@ -84,12 +85,21 @@

                 ret->udecls[i]->synth = 1;

             break;

+        case Tyvar:

+            if (delayed && hthas(delayed, t)) {

+                ret = tydup(t);

+                tmp = htget(delayed, t);

+                htput(delayed, ret, tyspecialize(tmp, tsmap, delayed));

+            } else {

+                ret = t;

+            }

+            break;

         default:

             if (t->nsub > 0) {

                 ret = tydup(t);

                 htput(tsmap, t, ret);

                 for (i = 0; i < t->nsub; i++)

-                    ret->sub[i] = tyspecialize(t->sub[i], tsmap);

+                    ret->sub[i] = tyspecialize(t->sub[i], tsmap, delayed);

             } else {

                 ret = t;

@@ -104,7 +114,7 @@

 static Type *tysubst(Type *t, Htab *tsmap)

     if (hasparams(t))

-        return tyspecialize(t, tsmap);

+        return tyspecialize(t, tsmap, NULL);

     else

         return t;

--- a/parse/type.c

+++ b/parse/type.c

@@ -297,6 +297,11 @@

     if (t->type != Tyname && t->type != Tyunres)

         return 0;

+    /*

+    if we have no arguments passed in, and we have parameters

+    we have a type of the form

+    type t(@a,...) = ...

+     */

     if (!t->narg)

         return t->nparam > 0;

     else

@@ -310,21 +315,46 @@

  * Checks if a type contains any type

  * parameers at all (ie, if it generic).

*/

-int hasparams(Type *t)

+int hasparamsrec(Type *t, Bitset *visited)

     size_t i;

-    if (t->type == Typaram || isgeneric(t))

-        return 1;

-    for (i = 0; i < t->nsub; i++)

-        if (hasparams(t->sub[i]))

+    switch (t->type) {

+        case Typaram:

             return 1;

-    for (i = 0; i < t->narg; i++)

-        if (hasparams(t->arg[i]))

-            return 1;

+        case Tyname:

+        case Tyunres:

+            return isgeneric(t);

+        case Tystruct:

+            for (i = 0; i < t->nmemb; i++)

+                if (hasparamsrec(t->sdecls[i]->decl.type, visited))

+                    return 1;

+            break;

+        case Tyunion:

+            for (i = 0; i < t->nmemb; i++)

+                if (t->udecls[i]->etype && hasparamsrec(t->udecls[i]->etype, visited))

+                    return 1;

+            break;

+        default:

+            for (i = 0; i < t->nsub; i++)

+                if (hasparams(t->sub[i]))

+                    return 1;

+            break;

+    }

     return 0;

+int hasparams(Type *t)

+{

+    Bitset *visited;

+    int r;

+    visited = mkbs();

+    r = hasparamsrec(t, visited);

+    bsfree(visited);

+    return r;

+}

 Type *tybase(Type *t)

     assert(t != NULL);

@@ -414,9 +444,13 @@

     p += snprintf(p, end - p, "union ");

     for (i = 0; i < t->nmemb; i++) {

         name = namestr(t->udecls[i]->name);

-        ty = tystr(t->udecls[i]->etype);

-        p += snprintf(p, end - p, "`%s %s; ", name, ty);

-        free(ty);

+        if (t->udecls[i]->etype) {

+            ty = tystr(t->udecls[i]->etype);

+            p += snprintf(p, end - p, "`%s %s; ", name, ty);

+            free(ty);

+        } else {

+            p += snprintf(p, end - p, "`%s; ", name);

+        }

     p += snprintf(p, end - p, ";;");

     return p - buf;

binary files a/test/genericmake /dev/null differ

--- /dev/null

+++ b/test/genericmake.myr

@@ -1,0 +1,20 @@

+use std

+type t(@ty) = union

+	`Some @ty

+	`None

+;;

+const make = {v

+	-> `Some v

+}

+const main = {

+	var x

+	x = make(123)

+	match x

+	| `std.Some v:	std.put("val = %i\n", v)

+	| `std.None:	std.die("Unreachable\n")

+	;;

+}

--- /dev/null

+++ b/test/genericuret.myr

@@ -1,0 +1,10 @@

+use std

+generic work = {val : @a

+	-> `std.Some val

+}

+const main = {

+	work(123)

+	std.exit(42)

+}

--- a/test/tests

+++ b/test/tests

@@ -86,6 +86,7 @@

 B genericrec	E	0

 # B genericchain	P	"val = 123" ## BUGGERED

 B genericmake	P	"val = 123"

+B genericuret	E	42

 B stdopt-some	E	42

 B stdopt-none	E	42

 B stdopt-mk	E	42

--

⑨