summaryrefslogtreecommitdiff
path: root/appl/alphabet/eval.b
diff options
context:
space:
mode:
Diffstat (limited to 'appl/alphabet/eval.b')
-rw-r--r--appl/alphabet/eval.b757
1 files changed, 757 insertions, 0 deletions
diff --git a/appl/alphabet/eval.b b/appl/alphabet/eval.b
new file mode 100644
index 00000000..b63b9f7e
--- /dev/null
+++ b/appl/alphabet/eval.b
@@ -0,0 +1,757 @@
+implement Eval;
+include "sys.m";
+ sys: Sys;
+include "draw.m";
+include "sh.m";
+ sh: Sh;
+ n_BLOCK, n_VAR, n_BQ, n_BQ2, n_REDIR,
+ n_DUP, n_LIST, n_SEQ, n_CONCAT, n_PIPE, n_ADJ,
+ n_WORD, n_NOWAIT, n_SQUASH, n_COUNT,
+ n_ASSIGN, n_LOCAL: import sh;
+include "alphabet/reports.m";
+ reports: Reports;
+ Report, report: import reports;
+include "alphabet.m";
+
+# XXX /usr/inferno/appl/alphabet/eval.b:189: function call type mismatch
+# ... a remarkably uninformative error message!
+
+checkload[T](m: T, path: string): T
+{
+ if(m != nil)
+ return m;
+ sys->fprint(sys->fildes(2), "eval: cannot load %s: %r\n", path);
+ raise "fail:bad module";
+}
+
+init()
+{
+ sys = load Sys Sys->PATH;
+ reports = checkload(load Reports Reports->PATH, Reports->PATH);
+ sh = checkload(load Sh Sh->PATH, Sh->PATH);
+}
+
+WORD, VALUE: con iota;
+
+# to do:
+# - change value letters to more appropriate (e.g. fs->f, entries->e, gate->g).
+# - allow shell $variable expansions
+
+Evalstate: adt[V, M, C]
+ for {
+ V =>
+ dup: fn(t: self V): V;
+ free: fn(t: self V, used: int);
+ gets: fn(t: self V): string;
+ isstring: fn(t: self V): int;
+ type2s: fn(tc: int): string;
+ typec: fn(t: self V): int;
+ M =>
+ find: fn(c: C, s: string): (M, string);
+ typesig: fn(m: self M): string;
+ run: fn(m: self M, c: C,
+ errorc: chan of string,
+ opts: list of (int, list of V), args: list of V): V;
+ mks: fn(c: C, s: string): V;
+ mkc: fn(c: C, cmd: ref Sh->Cmd): V;
+ typename2c: fn(s: string): int;
+ cvt: fn(c: C, v: V, tc: int, errorc: chan of string): V;
+ }
+{
+ ctxt: C;
+ errorc: chan of string;
+
+ expr: fn(e: self ref Evalstate, c: ref Sh->Cmd, env: Env[V]): V;
+ runcmd: fn(e: self ref Evalstate, cmd: ref Sh->Cmd, arg0: V, args: list of V): V;
+ getargs: fn(e: self ref Evalstate, c: ref Sh->Cmd, env: Env[V]): (ref Sh->Cmd, list of V);
+ getvar: fn(e: self ref Evalstate, c: ref Sh->Cmd, env: Env[V]): V;
+};
+
+Env: adt[V]
+ for {
+ V =>
+ free: fn(v: self V, used: int);
+ dup: fn(v: self V): V;
+ }
+{
+ items: array of V;
+
+ new: fn(args: list of V, nilval: V): Env[V];
+ get: fn(t: self Env, id: int): V;
+ discard: fn(t: self Env);
+};
+
+Context[V, M, Ectxt].eval(expr: ref Sh->Cmd, ctxt: Ectxt, errorc: chan of string,
+ args: list of V): V
+{
+ if(expr == nil){
+ discardlist(nil, args);
+ return nil;
+ }
+ nilv: V;
+ e := ref Evalstate[V, M, Ectxt](ctxt, errorc);
+ {
+ return e.runcmd(expr, nilv, args);
+ } exception x {
+ "error:*" =>
+ report(e.errorc, x);
+ return nil;
+ }
+}
+
+Evalstate[V,M,C].expr(e: self ref Evalstate, c: ref Sh->Cmd, env: Env[V]): V
+{
+ op: ref Sh->Cmd;
+ args: list of V;
+ arg0: V;
+ case c.ntype {
+ n_PIPE =>
+ if(c.left == nil){
+ # N.B. side effect on env.
+ arg0 = env.items[0];
+ env.items[0] = nil;
+ env.items = env.items[1:];
+ }else
+ arg0 = e.expr(c.left, env);
+ {
+ (op, args) = e.getargs(c.right, env);
+ } exception {
+ "error:*" =>
+ arg0.free(0);
+ raise;
+ }
+ n_ADJ or
+ n_WORD or
+ n_BLOCK or
+ n_BQ2 =>
+ (op, args) = e.getargs(c, env);
+ * =>
+ raise "error: expected pipe, adj or word, got " + sh->cmd2string(c);
+ }
+
+ return e.runcmd(op, arg0, args);
+}
+
+# a b c -> adj(adj('a', 'b'), 'c')
+Evalstate[V,M,C].getargs(e: self ref Evalstate, c: ref Sh->Cmd, env: Env[V]): (ref Sh->Cmd, list of V)
+{
+ # do a quick sanity check of module/command-block type
+ for(d := c; d.ntype == n_ADJ; d = d.left)
+ ;
+ if(d.ntype != n_WORD && d.ntype != n_BLOCK)
+ raise "error: expected word or block, got "+sh->cmd2string(d);
+ args: list of V;
+ for(; c.ntype == n_ADJ; c = c.left){
+ r: V;
+ case c.right.ntype {
+ n_VAR =>
+ r = e.getvar(c.right.left, env);
+ n_BLOCK =>
+ r = e.expr(c.right.left, env);
+ n_WORD =>
+ r = M.mks(e.ctxt, deglob(c.right.word));
+ n_BQ2 =>
+ r = M.mkc(e.ctxt, c.right.left);
+ * =>
+ discardlist(nil, args);
+ raise "error: syntax error: expected var, block or word. got "+sh->cmd2string(c);
+ }
+ args = r :: args;
+ }
+ return (c, args);
+}
+
+Evalstate[V,M,C].getvar(nil: self ref Evalstate, c: ref Sh->Cmd, env: Env[V]): V
+{
+ if(c == nil || c.ntype != n_WORD)
+ raise "error: bad variable name";
+ var := deglob(c.word);
+ v := env.get(int var);
+ if(v == nil)
+ raise sys->sprint("error: $%q not defined or cannot be reused", var);
+ return v;
+}
+
+# get rid of GLOB characters left there by the shell.
+deglob(s: string): string
+{
+ j := 0;
+ for (i := 0; i < len s; i++) {
+ if (s[i] != Sh->GLOB) {
+ if (i != j) # a worthy optimisation???
+ s[j] = s[i];
+ j++;
+ }
+ }
+ if (i == j)
+ return s;
+ return s[0:j];
+}
+
+Evalstate[V,M,C].runcmd(e: self ref Evalstate, cmd: ref Sh->Cmd, arg0: V, args: list of V): V
+{
+ m: M;
+ sig: string;
+ err: string;
+ if(cmd.ntype == n_WORD){
+ (m, err) = M.find(e.ctxt, cmd.word);
+ if(err != nil){
+ discardlist(nil, arg0::args);
+ raise sys->sprint("error: cannot load %q: %s", cmd.word, err);
+ }
+ sig = m.typesig();
+ }else{
+ (sig, cmd, err) = blocksig0(m, e.ctxt, cmd);
+ if(sig == nil){
+ discardlist(nil, arg0::args);
+ raise sys->sprint("error: invalid command: %s", err);
+ }
+ }
+ ok: int;
+ opts: list of (int, list of V);
+ x: M;
+ (ok, opts, args) = cvtargs(x, e.ctxt, sig, cmd, arg0, args, e.errorc);
+ if(ok == -1){
+ x: V;
+ discardlist(opts, args);
+ raise "error: usage: " + sh->cmd2string(cmd)+" "+cmdusage(x, sig);
+ }
+ if(m != nil){
+ r := m.run(e.ctxt, e.errorc, opts, args);
+ if(r == nil)
+ raise "error: command failed";
+ return r;
+ }else{
+ v: V; # XXX prevent spurious (?) compiler error message: "type polymorphic type does not have a 'discard' function"
+ env := Env[V].new(args, v);
+ {
+ v = e.expr(cmd, env);
+ env.discard();
+ return v;
+ } exception ex {
+ "error:*" =>
+ env.discard();
+ raise;
+ }
+ }
+}
+
+# {(fd string); walk $2 | merge {unbundle $1}}
+blocksig[M, Ectxt](nilm: M, ctxt: Ectxt, e: ref Sh->Cmd): (string, string)
+ for{
+ M =>
+ typename2c: fn(s: string): int;
+ find: fn(c: Ectxt, s: string): (M, string);
+ typesig: fn(m: self M): string;
+ }
+{
+ (sig, nil, err) := blocksig0(nilm, ctxt, e);
+ return (sig, err);
+}
+
+# {(fd string); walk $2 | merge {unbundle $1}}
+blocksig0[M, Ectxt](nilm: M, ctxt, e: ref Sh->Cmd): (string, ref Sh->Cmd, string)
+ for{
+ M =>
+ typename2c: fn(s: string): int;
+ find: fn(c: Ectxt, s: string): (M, string);
+ typesig: fn(m: self M): string;
+ }
+{
+ if(e == nil || e.ntype != n_BLOCK)
+ return (nil, nil, "expected block, got "+sh->cmd2string(e));
+ e = e.left;
+
+
+ if(e == nil || e.ntype != n_SEQ || e.left == nil || e.left.ntype != n_LIST){
+ (ptc, err) := pipesig(nilm, ctxt, e);
+ if(err != nil)
+ return (nil, nil, err);
+ sig := "a";
+ if(ptc != -1)
+ sig[len sig] = ptc;
+ return (sig, e, nil);
+ }
+
+ r := e.right;
+ e = e.left.left;
+ if(e == nil)
+ return ("a", r, nil);
+ argt: list of string;
+ while(e.ntype == n_ADJ){
+ if(e.right.ntype != n_WORD)
+ return (nil, nil, "bad declaration: expected word, got "+sh->cmd2string(e.right));
+ argt = deglob(e.right.word) :: argt;
+ e = e.left;
+ }
+ if(e.ntype != n_WORD)
+ return (nil, nil, "bad declaration: expected word, got "+sh->cmd2string(e));
+ argt = e.word :: argt;
+ i := 1;
+ sig := "a";
+ (ptc, err) := pipesig(nilm, ctxt, r);
+ if(err != nil)
+ return (nil, nil, err);
+ if(ptc != -1)
+ sig[len sig] = ptc;
+
+ for(a := argt; a != nil; a = tl a){
+ tc := M.typename2c(hd a);
+ if(tc == -1)
+ return (nil, nil, sys->sprint("unknown type %q", hd a));
+ sig[len sig] = tc;
+ i++;
+ }
+ return (sig, r, nil);
+}
+
+# if e represents an expression with an empty first pipe element,
+# return the type of its first argument (-1 if it doesn't).
+# string represents error if module doesn't have a first argument.
+pipesig[M, Ectxt](nilm: M, ctxt: Ectxt, e: ref Sh->Cmd): (int, string)
+ for{
+ M =>
+ typename2c: fn(s: string): int;
+ find: fn(c: Ectxt, s: string): (M, string);
+ typesig: fn(m: self M): string;
+ }
+{
+ if(e == nil)
+ return (-1, nil);
+ for(; e.ntype == n_PIPE; e = e.left){
+ if(e.left == nil){
+ # find actual module that's being called.
+ for(e = e.right; e.ntype == n_ADJ; e = e.left)
+ ;
+ sig: string;
+ if(e.ntype == n_WORD){
+ (m, err) := M.find(ctxt, e.word);
+ if(m == nil)
+ return (-1, err);
+ sig = m.typesig();
+ }
+ else if(e.ntype == n_BLOCK){
+ err: string;
+ (sig, nil, err) = blocksig0(nilm, ctxt, e);
+ if(sig == nil)
+ return (-1, err);
+ }else
+ return (-1, "expected word or block, got "+sh->cmd2string(e));
+ if(len sig < 2)
+ return (-1, "cannot pipe into "+sh->cmd2string(e));
+ return (sig[1], nil);
+ }
+ }
+ return (-1, nil);
+}
+
+cvtargs[M,V,C](nil: M, ctxt: C, otype: string, cmd: ref Sh->Cmd, arg0: V, args: list of V, errorc: chan of string): (int, list of (int, list of V), list of V)
+ for{
+ V =>
+ typec: fn(v: self V): int;
+ isstring: fn(v: self V): int;
+ type2s: fn(tc: int): string;
+ gets: fn(v: self V): string;
+ M =>
+ cvt: fn(c: C, v: V, tc: int, errorc: chan of string): V;
+ mks: fn(c: C, s: string): V;
+ }
+{
+ ok: int;
+ opts: list of (int, list of V);
+ (nil, at, t) := splittype(otype);
+ x: M;
+ (ok, opts, args) = cvtopts(x, ctxt, t, cmd, args, errorc);
+ if(arg0 != nil)
+ args = arg0 :: args;
+ if(ok == -1)
+ return (-1, opts, args);
+ if(len at > 0 && at[0] == '*'){
+ report(errorc, sys->sprint("error: invalid type descriptor %#q for %s", at, sh->cmd2string(cmd)));
+ return (-1, opts, args);
+ }
+ n := len args;
+ if(at != nil && at[len at - 1] == '*'){
+ tc := at[len at - 2];
+ at = at[0:len at - 2];
+ for(i := len at; i < n; i++)
+ at[i] = tc;
+ }
+ if(n != len at){
+ report(errorc, sys->sprint("error: wrong number of arguments (%d/%d) to %s", n, len at, sh->cmd2string(cmd)));
+ return (-1, opts, args);
+ }
+ d: list of V;
+ (ok, args, d) = cvtvalues(x, ctxt, at, cmd, args, errorc);
+ if(ok == -1)
+ args = join(args, d);
+ return (ok, opts, args);
+}
+
+cvtvalues[M,V,C](nil: M, ctxt: C, t: string, cmd: ref Sh->Cmd, args: list of V, errorc: chan of string): (int, list of V, list of V)
+ for{
+ V =>
+ type2s: fn(tc: int): string;
+ typec: fn(v: self V): int;
+ M =>
+ cvt: fn(c: C, v: V, tc: int, errorc: chan of string): V;
+ }
+{
+ cargs: list of V;
+ for(i := 0; i < len t; i++){
+ tc := t[i];
+ if(args == nil){
+ report(errorc, sys->sprint("error: missing argument of type %s for %s", V.type2s(tc), sh->cmd2string(cmd)));
+ return (-1, cargs, args);
+ }
+ v := M.cvt(ctxt, hd args, tc, errorc);
+ if(v == nil){
+ report(errorc, "error: conversion failed for "+sh->cmd2string(cmd));
+ return (-1, cargs, tl args);
+ }
+ cargs = v :: cargs;
+ args = tl args;
+ }
+ return (0, rev(cargs), args);
+}
+
+cvtopts[M,V,C](nil: M, ctxt: C, opttype: string, cmd: ref Sh->Cmd, args: list of V, errorc: chan of string): (int, list of (int, list of V), list of V)
+ for{
+ V =>
+ type2s: fn(tc: int): string;
+ isstring: fn(v: self V): int;
+ typec: fn(v: self V): int;
+ gets: fn(v: self V): string;
+ M =>
+ cvt: fn(c: C, v: V, tc: int, errorc: chan of string): V;
+ mks: fn(c: C, s: string): V;
+ }
+{
+ if(opttype == nil)
+ return (0, nil, args);
+ opts: list of (int, list of V);
+getopts:
+ while(args != nil){
+ s := "";
+ if((hd args).isstring()){
+ s = (hd args).gets();
+ if(s == nil || s[0] != '-' || len s == 1)
+ s = nil;
+ else if(s == "--"){
+ args = tl args;
+ s = nil;
+ }
+ }
+ if(s == nil)
+ return (0, opts, args);
+ s = s[1:];
+ while(len s > 0){
+ opt := s[0];
+ if(((ok, t) := opttypes(opt, opttype)).t0 == -1){
+ report(errorc, sys->sprint("error: unknown option -%c for %s", opt, sh->cmd2string(cmd)));
+ return (-1, opts, args);
+ }
+ if(t == nil){
+ s = s[1:];
+ opts = (opt, nil) :: opts;
+ }else{
+ if(len s > 1)
+ args = M.mks(ctxt, s[1:]) :: tl args;
+ else
+ args = tl args;
+ vl: list of V;
+ x: M;
+ (ok, vl, args) = cvtvalues(x, ctxt, t, cmd, args, errorc);
+ if(ok == -1)
+ return (-1, opts, join(vl, args));
+ opts = (opt, vl) :: opts;
+ continue getopts;
+ }
+ }
+ args = tl args;
+ }
+ return (0, opts, args);
+}
+
+discardlist[V](ol: list of (int, list of V), vl: list of V)
+ for{
+ V =>
+ free: fn(v: self V, used: int);
+ }
+{
+ for(; ol != nil; ol = tl ol)
+ for(ovl := (hd ol).t1; ovl != nil; ovl = tl ovl)
+ vl = (hd ovl) :: vl;
+ for(; vl != nil; vl = tl vl)
+ (hd vl).free(0);
+}
+
+# true if a module with type sig t1 is compatible with a caller that expects t0
+typecompat(t0, t1: string): int
+{
+ (rt0, at0, ot0) := splittype(t0);
+ (rt1, at1, ot1) := splittype(t1);
+
+ if((rt0 != rt1 && rt0 != 'a') || at0 != at1) # XXX could do better for repeated args.
+ return 0;
+
+ for(i := 1; i < len ot0; i++){
+ for(j := i; j < len ot0; j++)
+ if(ot0[j] == '-')
+ break;
+ (ok, t) := opttypes(ot0[i], ot1);
+ if(ok == -1 || ot0[i+1:j] != t)
+ return 0;
+ i = j;
+ }
+ return 1;
+}
+
+splittype(t: string): (int, string, string)
+{
+ if(t == nil)
+ return (-1, nil, nil);
+ for(i := 1; i < len t; i++)
+ if(t[i] == '-')
+ break;
+ return (t[0], t[1:i], t[i:]);
+}
+
+opttypes(opt: int, opts: string): (int, string)
+{
+ for(i := 1; i < len opts; i++){
+ if(opts[i] == opt && opts[i-1] == '-'){
+ for(j := i+1; j < len opts; j++)
+ if(opts[j] == '-')
+ break;
+ return (0, opts[i+1:j]);
+ }
+ }
+ return (-1, nil);
+}
+
+usage2sig[V](nil: V, u: string): (string, string)
+ for{
+ V =>
+ typename2c: fn(s: string): int;
+ }
+{
+ u[len u] = '\0';
+
+ i := 0;
+ t: int;
+ tok: string;
+
+ # options
+ opts: string;
+ for(;;){
+ (t, tok, i) = optstok(u, i);
+ if(t != '[')
+ break;
+ o := i;
+ (t, tok, i) = optstok(u, i);
+ if(t != '-'){
+ i = o;
+ t = '[';
+ break;
+ }
+ for(j := 0; j < len tok; j++){
+ opts[len opts] = '-';
+ opts[len opts] = tok[j];
+ }
+ for(;;){
+ (t, tok, i) = optstok(u, i);
+ if(t == ']')
+ break;
+ if(t != 't')
+ return (nil, sys->sprint("bad option syntax, got '%c'", t));
+ tc := V.typename2c(tok);
+ if(tc == -1)
+ return (nil, "unknown type: "+tok);
+ opts[len opts] = tc;
+ }
+ }
+
+ # arguments
+ args: string;
+parseargs:
+ for(;;){
+ case t {
+ '>' =>
+ break parseargs;
+ '[' =>
+ (t, tok, i) = optstok(u, i);
+ if(t != 't')
+ return (nil, "bad argument syntax");
+ tc := V.typename2c(tok);
+ if(tc == -1)
+ return (nil, "unknown type: "+tok);
+ if(((t, nil, i) = optstok(u, i)).t0 != '*')
+ return (nil, "bad argument syntax");
+ if(((t, nil, i) = optstok(u, i)).t0 != ']')
+ return (nil, "bad argument syntax");
+ if(((t, nil, i) = optstok(u, i)).t0 != '>')
+ return (nil, "bad argument syntax");
+ args[len args] = tc;
+ args[len args] = '*';
+ break parseargs;
+ 't' =>
+ tc := V.typename2c(tok);
+ if(tc == -1)
+ return (nil, "unknown type: "+tok);
+ args[len args] = tc;
+ (t, tok, i) = optstok(u, i);
+ * =>
+ return (nil, "no return type");
+ }
+ }
+
+ # return type
+ (t, tok, i) = optstok(u, i);
+ if(t != 't')
+ return (nil, "expected return type");
+ tc := V.typename2c(tok);
+ if(tc == -1)
+ return (nil, "unknown type: "+tok);
+ r: string;
+ r[0] = tc;
+ r += args;
+ r += opts;
+ return (r, nil);
+}
+
+optstok(u: string, i: int): (int, string, int)
+{
+ while(u[i] == ' ')
+ i++;
+ case u[i] {
+ '\0' =>
+ return (-1, nil, i);
+ '-' =>
+ i++;
+ if(u[i] == '>')
+ return ('>', nil, i+1);
+ start := i;
+ while((c := u[i]) != '\0'){
+ if(c == ']' || c == ' ')
+ break;
+ i++;
+ }
+ return ('-', u[start:i], i);
+ '[' =>
+ return (u[i], nil, i+1);
+ ']' =>
+ return (u[i], nil, i+1);
+ '.' =>
+ start := i;
+ while(u[i] == '.')
+ i++;
+ if(i - start < 3)
+ raise "parse:error at '.'";
+ return ('*', nil, i);
+ * =>
+ start := i;
+ while((c := u[i]) != '\0'){
+ if(c == ' ' || c == ']' || c == '-' || (c == '.' && u[i+1] == '.'))
+ return ('t', u[start:i], i);
+ i++;
+ }
+ return ('t', u[start:i], i);
+ }
+}
+
+cmdusage[V](nil: V, t: string): string
+ for{
+ V =>
+ type2s: fn(c: int): string;
+ }
+{
+ if(t == nil)
+ return "-> bad";
+ for(oi := 0; oi < len t; oi++)
+ if(t[oi] == '-')
+ break;
+ s := "";
+ if(oi < len t){
+ single, multi: string;
+ for(i := oi; i < len t - 1;){
+ for(j := i + 1; j < len t; j++)
+ if(t[j] == '-')
+ break;
+
+ optargs := t[i+2:j];
+ if(optargs == nil)
+ single[len single] = t[i+1];
+ else{
+ multi += sys->sprint(" [-%c", t[i+1]);
+ for (k := 0; k < len optargs; k++)
+ multi += " " + V.type2s(optargs[k]);
+ multi += "]";
+ }
+ i = j;
+ }
+ if(single != nil)
+ s += " [-" + single + "]";
+ s += multi;
+ }
+ multi := 0;
+ if(oi > 2 && t[oi - 1] == '*'){
+ multi = 1;
+ oi -= 2;
+ }
+ for(k := 1; k < oi; k++)
+ s += " " + V.type2s(t[k]);
+ if(multi)
+ s += " [" + V.type2s(t[k]) + "...]";
+ s += " -> " + V.type2s(t[0]);
+ if(s[0] == ' ')
+ s=s[1:];
+ return s;
+}
+
+Env[V].new(args: list of V, nilval: V): Env[V]
+{
+ if(args == nil)
+ return Env(nil);
+ e := Env[V](array[len args] of {* => nilval});
+ for(i := 0; args != nil; args = tl args)
+ e.items[i++] = hd args;
+ return e;
+}
+
+Env[V].get(t: self Env, id: int): V
+{
+ id--;
+ if(id < 0 || id >= len t.items)
+ return nil;
+ x := t.items[id];
+ if((y := x.dup()) == nil){
+ t.items[id] = nil;
+ y = x;
+ }
+ return y;
+}
+
+Env[V].discard(t: self Env)
+{
+ for(i := 0; i < len t.items; i++)
+ t.items[i].free(0);
+}
+
+rev[T](x: list of T): list of T
+{
+ l: list of T;
+ for(; x != nil; x = tl x)
+ l = hd x :: l;
+ return l;
+}
+
+# join x to y, leaving result in arbitrary order.
+join[T](x, y: list of T): list of T
+{
+ if(len x > len y)
+ (x, y) = (y, x);
+ for(; x != nil; x = tl x)
+ y = hd x :: y;
+ return y;
+}