ref: 5ae8f105a5e471a63033238946f7596e26ed0ab5
parent: aac963bab444439931935d99e557fcb33b9b6878
parent: 4a8b6a32bd2e06a803b203fe90b7b1253e57f362
author: akoshibe <akoshibe@eigenstate.org>
date: Tue Aug 5 20:12:03 EDT 2014
Merge branch 'master' of https://github.com/oridb/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/libstd/sys-freebsd.myr
+++ b/libstd/sys-freebsd.myr
@@ -11,6 +11,7 @@
type sockproto = int64 /* socket protocol */
type sockfam = uint8 /* socket family */
type filemode = uint16
+ type filetype = uint8
type clock = union
`Clockrealtime
@@ -109,11 +110,22 @@
type dirent = struct
fileno : uint32
reclen : uint16
- type : filetype
+ ftype : filetype
namelen : uint8
name : byte[256]
;;
+ /* open options */
+ const Ordonly : fdopt = 0x0
+ const Owronly : fdopt = 0x1
+ const Ordwr : fdopt = 0x2
+ const Oappend : fdopt = 0x8
+ const Ocreat : fdopt = 0x200
+ const Onofollow : fdopt = 0x100
+ const Ondelay : fdopt = 0x4
+ const Otrunc : fdopt = 0x400
+ const Odir : fdopt = 0x20000
+
/* stat modes */
const Sifmt : filemode = 0xf000
const Sififo : filemode = 0x1000
@@ -124,6 +136,21 @@
const Siflnk : filemode = 0xa000
const Sifsock : filemode = 0xc000
+ /* mmap protection */
+ const Mprotnone : mprot = 0x0
+ const Mprotrd : mprot = 0x1
+ const Mprotwr : mprot = 0x2
+ const Mprotexec : mprot = 0x4
+ const Mprotrw : mprot = 0x3
+
+ /* mmap options */
+ const Mshared : mopt = 0x1
+ const Mpriv : mopt = 0x2
+ const Mfixed : mopt = 0x10
+ const Mfile : mopt = 0x0
+ const Manon : mopt = 0x1000
+ const M32bit : mopt = 0x80000
+
/* file types */
const Dtunknown : filetype = 0
const Dtfifo : filetype = 1
@@ -134,6 +161,31 @@
const Dtlnk : filetype = 10
const Dtsock : filetype = 12
const Dtwht : filetype = 14
+
+ /* socket families. INCOMPLETE. */
+ const Afunspec : sockfam = 0
+ const Afunix : sockfam = 1
+ const Afinet : sockfam = 2
+ const Afinet6 : sockfam = 28
+
+ /* socket types. */
+ const Sockstream : socktype = 1
+ const Sockdgram : socktype = 2
+ const Sockraw : socktype = 3
+ const Sockrdm : socktype = 4
+ const Sockseqpacket : socktype = 5
+
+ /* network protocols */
+ const Ipproto_ip : sockproto = 0
+ const Ipproto_icmp : sockproto = 1
+ const Ipproto_tcp : sockproto = 6
+ const Ipproto_udp : sockproto = 17
+ const Ipproto_raw : sockproto = 255
+
+ /* return value for a failed mapping */
+ const Mapbad : byte# = -1 castto(byte#)
+
+ /* syscalls */
const Syssyscall : scno = 0
const Sysexit : scno = 1
const Sysfork : scno = 2
@@ -593,3 +645,123 @@
const uname : (buf : utsname# -> int)
const sysctl : (mib : int[:], old : byte[:]#, new : byte[:] -> int)
;;
+
+extern const cstring : (str : byte[:] -> byte#)
+extern const alloca : (sz : size -> byte#)
+extern const __cenvp : byte##
+
+/* process management */
+const exit = {status; syscall(Sysexit, status castto(int64))}+const getpid = {; -> syscall(Sysgetpid, 1)}+const kill = {pid, sig; -> syscall(Syskill, pid, sig)}+const fork = {; -> syscall(Sysfork)}+const wait4 = {pid, loc, opt, usage; -> syscall(Syswait4, pid, loc, opt, usage)}+const waitpid = {pid, loc, opt;+ -> wait4(pid, loc, opt, 0 castto(rusage#))
+}
+
+const execv = {cmd, args+ var p, cargs, i
+
+ /* of course we fucking have to duplicate this code everywhere,
+ * since we want to stack allocate... */
+ p = alloca((args.len + 1)*sizeof(byte#))
+ cargs = (p castto(byte##))[:args.len]
+ for i = 0; i < args.len; i++
+ cargs[i] = cstring(args[i])
+ ;;
+ cargs[args.len] = 0 castto(byte#)
+ -> syscall(Sysexecve, cstring(cmd), p, __cenvp)
+}
+
+const execve = {cmd, args, env+ var cargs, cenv, i
+ var p
+
+ /* copy the args */
+ p = alloca((args.len + 1)*sizeof(byte#))
+ cargs = (p castto(byte##))[:args.len]
+ for i = 0; i < args.len; i++
+ cargs[i] = cstring(args[i])
+ ;;
+ cargs[args.len] = 0 castto(byte#)
+
+ /*
+ copy the env.
+ of course we fucking have to duplicate this code everywhere,
+ since we want to stack allocate...
+ */
+ p = alloca((env.len + 1)*sizeof(byte#))
+ cenv = (p castto(byte##))[:env.len]
+ for i = 0; i < env.len; i++
+ cenv[i] = cstring(env[i])
+ ;;
+ cenv[env.len] = 0 castto(byte#)
+
+ -> syscall(Sysexecve, cstring(cmd), p, cenv)
+}
+
+/* fd manipulation */
+const open = {path, opts; -> syscall(Sysopen, cstring(path), opts, 0o777) castto(fd)}+const openmode = {path, opts, mode; -> syscall(Sysopen, cstring(path), opts, mode) castto(fd)}+const close = {fd; -> syscall(Sysclose, fd)}+const creat = {path, mode; -> openmode(path, Ocreat | Otrunc | Owronly, mode) castto(fd)}+const read = {fd, buf; -> syscall(Sysread, fd, buf castto(byte#), buf.len castto(size)) castto(size)}+const write = {fd, buf; -> syscall(Syswrite, fd, buf castto(byte#), buf.len castto(size)) castto(size)}+const lseek = {fd, off, whence; -> syscall(Syslseek, fd, off, whence)}+const stat = {path, sb; -> syscall(Sysstat, cstring(path), sb)}+const lstat = {path, sb; -> syscall(Syslstat, cstring(path), sb)}+const fstat = {fd, sb; -> syscall(Sysfstat, fd, sb)}+const mkdir = {path, mode; -> syscall(Sysmkdir, cstring(path), mode) castto(int64)}+const ioctl = {fd, req, args+ var arg : byte#
+ var ap
+
+ ap = vastart(&args)
+ (arg, ap) = vanext(ap)
+ -> syscall(Sysioctl, fd, req, arg) castto(int64)
+}
+const getdirentries64 = {fd, buf, basep; -> syscall(Sysgetdirentries, fd, buf castto(byte#), buf.len castto(size), basep)}+
+/* networking */
+const socket = {dom, stype, proto; -> syscall(Syssocket, dom castto(int64), stype, proto) castto(fd) }+const connect = {sock, addr, len; -> syscall(Sysconnect, sock, addr, len) castto(int)}+const accept = {sock, addr, len; -> syscall(Sysaccept, sock, addr, len) castto(fd)}+const listen = {sock, backlog; -> syscall(Syslisten, sock, backlog castto(int64)) castto(int)}+const bind = {sock, addr, len; -> syscall(Sysbind, sock, addr, len) castto(int)}+
+/* memory management */
+const munmap = {addr, len; -> syscall(Sysmunmap, addr, len)}+const mmap = {addr, len, prot, flags, fd, off; -> syscall(Sysmmap, addr, len, prot, flags, fd, off) castto(byte#)}+
+/* time */
+const clock_getres = {clk, ts; -> syscall(Sysclock_getres, clockid(clk), ts) castto(int32)}+const clock_gettime = {clk, ts; -> syscall(Sysclock_gettime, clockid(clk), ts) castto(int32)}+const clock_settime = {clk, ts; -> syscall(Sysclock_settime, clockid(clk), ts) castto(int32)}+
+/* system information */
+const uname = {buf; -> syscall(Sysuname, buf) castto(int)}+
+const sysctl = {mib, old, new+ var mibp
+ var mibsz
+ var o
+ var oldp
+ var oldsz
+ var newp
+ var newsz
+ var ret
+
+ mibp = mib castto(byte#)
+ mibsz = mib.len castto(uint64)
+ o = old#
+ oldp = o castto(byte#)
+ oldsz = o.len castto(uint64)
+ newp = new castto(byte#)
+ newsz = new castto(uint64)
+
+ ret = syscall(Sys__sysctl, mibp, mibsz, oldp, &oldsz, newp, newsz) castto(int)
+
+ old# = o[:oldsz]
+ -> ret
+}
--- 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
--
⑨