diff options
Diffstat (limited to 'appl/cmd')
| -rw-r--r-- | appl/cmd/calc.b | 2547 | ||||
| -rw-r--r-- | appl/cmd/mc.b | 2618 |
2 files changed, 2655 insertions, 2510 deletions
diff --git a/appl/cmd/calc.b b/appl/cmd/calc.b new file mode 100644 index 00000000..3d18e976 --- /dev/null +++ b/appl/cmd/calc.b @@ -0,0 +1,2547 @@ +implement Calc; + +include "sys.m"; + sys: Sys; +include "draw.m"; +include "arg.m"; + arg: Arg; +include "bufio.m"; + bufio: Bufio; + Iobuf: import bufio; +include "math.m"; + maths: Math; +include "rand.m"; + rand: Rand; +include "daytime.m"; + daytime: Daytime; + +Calc: module +{ + init: fn(nil: ref Draw->Context, argv: list of string); +}; + +init(nil: ref Draw->Context, args: list of string) +{ + sys = load Sys Sys->PATH; + arg = load Arg Arg->PATH; + bufio = load Bufio Bufio->PATH; + maths = load Math Math->PATH; + rand = load Rand Rand->PATH; + daytime = load Daytime Daytime->PATH; + + maths->FPcontrol(0, Math->INVAL|Math->ZDIV|Math->OVFL|Math->UNFL|Math->INEX); + + rand->init(daytime->now()); + rand->init(rand->rand(Big)^rand->rand(Big)); + daytime = nil; + + arg->init(args); + while((c := arg->opt()) != 0){ + case(c){ + 'b' => + bits = 1; + 'd' => + debug = 1; + 's' => + strict = 1; + } + } + gargs = args = arg->argv(); + if(args == nil){ + stdin = 1; + bin = bufio->fopen(sys->fildes(0), Sys->OREAD); + } + else if(tl args == nil) + bin = bufio->open(hd args, Sys->OREAD); + + syms = array[Hash] of ref Sym; + + pushscope(); + for(i := 0; keyw[i].t0 != nil; i++) + enter(keyw[i].t0, keyw[i].t1); + for(i = 0; conw[i].t0 != nil; i++) + adddec(conw[i].t0, Ocon, conw[i].t1, 0); + for(i = 0; varw[i].t0 != nil; i++) + adddec(varw[i].t0, Ovar, varw[i].t1, 0); + for(i = 0; funw[i].t0 != nil; i++) + adddec(funw[i].t0, Olfun, real funw[i].t1, funw[i].t2); + + deg = lookup(Deg).dec; + pbase = lookup(Base).dec; + errdec = ref Dec; + + pushscope(); + for(;;){ + e: ref Node; + + { + t := lex(); + if(t == Oeof) + break; + unlex(t); + ls := lexes; + e = stat(1); + ckstat(e, Onothing, 0); + if(ls == lexes){ + t = lex(); + error(nil, sys->sprint("syntax error near %s", opstring(t))); + unlex(t); + } + consume(Onl); + } + exception ex{ + Eeof => + e = nil; + err("premature eof"); + skip(); + "*" => + e = nil; + err(ex); + skip(); + } + if(0 && debug) + prtree(e, 0); + if(e != nil && e.op != Ofn){ + (k, v) := (Onothing, 0.0); + { + (k, v) = estat(e); + } + exception ex{ + "*" => + e = nil; + err(ex); + } + if(pexp(e)) + printnum(v, "\n"); + if(k == Oexit) + exit; + } + } + popscope(); + popscope(); +} + +bits: int; +debug: int; +strict: int; + +None: con -2; +Eof: con -1; +Eeof: con "eof"; + +Hash: con 16; +Big: con 1<<30; +Maxint: con 16r7FFFFFFF; +Nan: con Math->NaN; +Infinity: con Math->Infinity; +Pi: con Math->Pi; +Eps: con 1E-10; +Bigeps: con 1E-2; +Ln2: con 0.6931471805599453; +Ln10: con 2.302585092994046; +Euler: con 2.71828182845904523536; +Gamma: con 0.57721566490153286060; +Phi: con 1.61803398874989484820; + +Oeof, +Ostring, Onum, Oident, Ocon, Ovar, Ofun, Olfun, +Oadd, Osub, Omul, Odiv, Omod, Oidiv, Oexp, Oand, Oor, Oxor, Olsh, Orsh, +Oadde, Osube, Omule, Odive, Omode, Oidive, Oexpe, Oande, Oore, Oxore, Olshe, Orshe, +Oeq, One, Ogt, Olt, Oge, Ole, +Oinc, Opreinc, Opostinc, Odec, Opredec, Opostdec, +Oandand, Ooror, +Oexc, Onot, Ofact, Ocom, +Oas, Odas, +Oplus, Ominus, Oinv, +Ocomma, Oscomma, Oquest, Ocolon, +Onand, Onor, Oimp, Oimpby, Oiff, +Olbr, Orbr, Olcbr, Orcbr, Oscolon, Onl, +Onothing, +Oprint, Oread, +Oif, Oelse, Ofor, Owhile, Odo, Obreak, Ocont, Oexit, Oret, Ofn, Oinclude, +Osigma, Opi, Ocfrac, Oderiv, Ointeg, Osolve, +Olog, Olog10, Olog2, Ologb, Oexpf, Opow, Osqrt, Ocbrt, Ofloor, Oceil, Omin, Omax, Oabs, Ogamma, Osign, Oint, Ofrac, Oround, Oerf, Oatan2, Osin, Ocos, Otan, Oasin, Oacos, Oatan, Osinh, Ocosh, Otanh, Oasinh, Oacosh, Oatanh, Orand, +Olast: con iota; + +Binary: con (1<<8); +Preunary: con (1<<9); +Postunary: con (1<<10); +Assoc: con (1<<11); +Rassoc: con (1<<12); +Prec: con Binary-1; + +opss := array[Olast] of +{ + "eof", + "string", + "number", + "identifier", + "constant", + "variable", + "function", + "library function", + "+", + "-", + "*", + "/", + "%", + "//", + "&", + "|", + "^", + "<<", + ">>", + "+=", + "-=", + "*=", + "/=", + "%=", + "//=", + "&=", + "|=", + "^=", + "<<=", + ">>=", + "==", + "!=", + ">", + "<", + ">=", + "<=", + "++", + "++", + "++", + "--", + "--", + "--", + "**", + "&&", + "||", + "!", + "!", + "!", + "~", + "=", + ":=", + "+", + "-", + "1/", + ",", + ",", + "?", + ":", + "↑", + "↓", + "->", + "<-", + "<->", + "(", + ")", + "{", + "}", + ";", + "\n", + "", +}; + +ops := array[Olast] of +{ + Oeof => 0, + Ostring => 17, + Onum => 17, + Oident => 17, + Ocon => 17, + Ovar => 17, + Ofun => 17, + Olfun => 17, + Oadd => 12|Binary|Assoc|Preunary, + Osub => 12|Binary|Preunary, + Omul => 13|Binary|Assoc, + Odiv => 13|Binary, + Omod => 13|Binary, + Oidiv => 13|Binary, + Oexp => 14|Binary|Rassoc, + Oand => 8|Binary|Assoc, + Oor => 6|Binary|Assoc, + Oxor => 7|Binary|Assoc, + Olsh => 11|Binary, + Orsh => 11|Binary, + Oadde => 2|Binary|Rassoc, + Osube => 2|Binary|Rassoc, + Omule => 2|Binary|Rassoc, + Odive => 2|Binary|Rassoc, + Omode => 2|Binary|Rassoc, + Oidive => 2|Binary|Rassoc, + Oexpe => 2|Binary|Rassoc, + Oande => 2|Binary|Rassoc, + Oore => 2|Binary|Rassoc, + Oxore => 2|Binary|Rassoc, + Olshe => 2|Binary|Rassoc, + Orshe => 2|Binary|Rassoc, + Oeq => 9|Binary, + One => 9|Binary, + Ogt => 10|Binary, + Olt => 10|Binary, + Oge => 10|Binary, + Ole => 10|Binary, + Oinc => 15|Rassoc|Preunary|Postunary, + Opreinc => 15|Rassoc|Preunary, + Opostinc => 15|Rassoc|Postunary, + Odec => 15|Rassoc|Preunary|Postunary, + Opredec => 15|Rassoc|Preunary, + Opostdec => 15|Rassoc|Postunary, + Oandand => 5|Binary|Assoc, + Ooror => 4|Binary|Assoc, + Oexc => 15|Rassoc|Preunary|Postunary, + Onot => 15|Rassoc|Preunary, + Ofact => 15|Rassoc|Postunary, + Ocom => 15|Rassoc|Preunary, + Oas => 2|Binary|Rassoc, + Odas => 2|Binary|Rassoc, + Oplus => 15|Rassoc|Preunary, + Ominus => 15|Rassoc|Preunary, + Oinv => 15|Rassoc|Postunary, + Ocomma => 1|Binary|Assoc, + Oscomma => 1|Binary|Assoc, + Oquest => 3|Binary|Rassoc, + Ocolon => 3|Binary|Rassoc, + Onand => 8|Binary, + Onor => 6|Binary, + Oimp => 9|Binary, + Oimpby => 9|Binary, + Oiff => 10|Binary|Assoc, + Olbr => 16, + Orbr => 16, + Onothing => 0, +}; + +Deg: con "degrees"; +Base: con "printbase"; +Limit: con "solvelimit"; +Step: con "solvestep"; + +keyw := array[] of +{ + ("include", Oinclude), + ("if", Oif), + ("else", Oelse), + ("for", Ofor), + ("while", Owhile), + ("do", Odo), + ("break", Obreak), + ("continue", Ocont), + ("exit", Oexit), + ("return", Oret), + ("print", Oprint), + ("read", Oread), + ("fn", Ofn), + ("", 0), +}; + +conw := array[] of +{ + ("π", Pi), + ("Pi", Pi), + ("e", Euler), + ("γ", Gamma), + ("Gamma", Gamma), + ("φ", Phi), + ("Phi", Phi), + ("∞", Infinity), + ("Infinity", Infinity), + ("NaN", Nan), + ("Nan", Nan), + ("nan", Nan), + ("", 0.0), +}; + +varw := array[] of +{ + (Deg, 0.0), + (Base, 10.0), + (Limit, 100.0), + (Step, 1.0), + ("", 0.0), +}; + +funw := array[] of +{ + ("log", Olog, 1), + ("ln", Olog, 1), + ("log10", Olog10, 1), + ("log2", Olog2, 1), + ("logb", Ologb, 2), + ("exp", Oexpf, 1), + ("pow", Opow, 2), + ("sqrt", Osqrt, 1), + ("cbrt", Ocbrt, 1), + ("floor", Ofloor, 1), + ("ceiling", Oceil, 1), + ("min", Omin, 2), + ("max", Omax, 2), + ("abs", Oabs, 1), + ("Γ", Ogamma, 1), + ("gamma", Ogamma, 1), + ("sign", Osign, 1), + ("int", Oint, 1), + ("frac", Ofrac, 1), + ("round", Oround, 1), + ("erf", Oerf, 1), + ("atan2", Oatan2, 2), + ("sin", Osin, 1), + ("cos", Ocos, 1), + ("tan", Otan, 1), + ("asin", Oasin, 1), + ("acos", Oacos, 1), + ("atan", Oatan, 1), + ("sinh", Osinh, 1), + ("cosh", Ocosh, 1), + ("tanh", Otanh, 1), + ("asinh", Oasinh, 1), + ("acosh", Oacosh, 1), + ("atanh", Oatanh, 1), + ("rand", Orand, 0), + ("Σ", Osigma, 3), + ("sigma", Osigma, 3), + ("Π", Opi, 3), + ("pi", Opi, 3), + ("cfrac", Ocfrac, 3), + ("Δ", Oderiv, 2), + ("differential", Oderiv, 2), + ("∫", Ointeg, 3), + ("integral", Ointeg, 3), + ("solve", Osolve, 1), + ("", 0, 0), +}; + +stdin: int; +bin: ref Iobuf; +lineno: int = 1; +file: string; +iostack: list of (int, int, int, string, ref Iobuf); +geof: int; +garg: string; +gargs: list of string; +bufc: int = None; +buft: int = Olast; +lexes: int; +lexval: real; +lexstr: string; +lexsym: ref Sym; +syms: array of ref Sym; +deg: ref Dec; +pbase: ref Dec; +errdec: ref Dec; +inloop: int; +infn: int; + +Node: adt +{ + op: int; + left: cyclic ref Node; + right: cyclic ref Node; + val: real; + str: string; + dec: cyclic ref Dec; + src: int; +}; + +Dec: adt +{ + kind: int; + scope: int; + sym: cyclic ref Sym; + val: real; + na: int; + code: cyclic ref Node; + old: cyclic ref Dec; + next: cyclic ref Dec; +}; + +Sym: adt +{ + name: string; + kind: int; + dec: cyclic ref Dec; + next: cyclic ref Sym; +}; + +opstring(t: int): string +{ + s := opss[t]; + if(s != nil) + return s; + for(i := 0; keyw[i].t0 != nil; i++) + if(t == keyw[i].t1) + return keyw[i].t0; + for(i = 0; funw[i].t0 != nil; i++) + if(t == funw[i].t1) + return funw[i].t0; + return s; +} + +err(s: string) +{ + sys->print("error: %s\n", s); +} + +error(n: ref Node, s: string) +{ + if(n != nil) + lno := n.src; + else + lno = lineno; + s = sys->sprint("line %d: %s", lno, s); + if(file != nil) + s = sys->sprint("file %s: %s", file, s); + raise s; +} + +fatal(s: string) +{ + sys->print("fatal: %s\n", s); + exit; +} + +stack(s: string, f: ref Iobuf) +{ + iostack = (bufc, buft, lineno, file, bin) :: iostack; + bufc = None; + buft = Olast; + lineno = 1; + file = s; + bin = f; +} + +unstack() +{ + (bufc, buft, lineno, file, bin) = hd iostack; + iostack = tl iostack; +} + +doinclude(s: string) +{ + f := bufio->open(s, Sys->OREAD); + if(f == nil) + error(nil, sys->sprint("cannot open %s", s)); + stack(s, f); +} + +getc(): int +{ + if((c := bufc) != None) + bufc = None; + else if(bin != nil) + c = bin.getc(); + else{ + if(garg == nil){ + if(gargs == nil){ + if(geof == 0){ + geof = 1; + c = '\n'; + } + else + c = Eof; + } + else{ + garg = hd gargs; + gargs = tl gargs; + c = ' '; + } + } + else{ + c = garg[0]; + garg = garg[1: ]; + } + } + if(c == Eof && iostack != nil){ + unstack(); + return getc(); + } + return c; +} + +ungetc(c: int) +{ + bufc = c; +} + +slash(c: int): int +{ + if(c != '\\') + return c; + nc := getc(); + case(nc){ + 'b' => return '\b'; + 'f' => return '\f'; + 'n' => return '\n'; + 'r' => return '\r'; + 't' => return '\t'; + } + return nc; +} + +lexstring(): int +{ + sp := ""; + while((c := getc()) != '"'){ + if(c == Eof) + raise Eeof; + sp[len sp] = slash(c); + } + lexstr = sp; + return Ostring; +} + +lexchar(): int +{ + while((c := getc()) != '\''){ + if(c == Eof) + raise Eeof; + lexval = real slash(c); + } + return Onum; +} + +basev(c: int, base: int): int +{ + if(c >= 'a' && c <= 'z') + c += 10-'a'; + else if(c >= 'A' && c <= 'Z') + c += 10-'A'; + else if(c >= '0' && c <= '9') + c -= '0'; + else + return -1; + if(c >= base) + error(nil, "bad digit"); + return c; +} + +lexe(base: int): int +{ + neg := 0; + v := big 0; + c := getc(); + if(c == '-') + neg = 1; + else + ungetc(c); + for(;;){ + c = getc(); + cc := basev(c, base); + if(cc < 0){ + ungetc(c); + break; + } + v = big base*v+big cc; + } + if(neg) + v = -v; + return int v; +} + +lexnum(): int +{ + base := 10; + exp := 0; + r := f := e := 0; + v := big 0; + c := getc(); + if(c == '0'){ + base = 8; + c = getc(); + if(c == '.'){ + base = 10; + ungetc(c); + } + else if(c == 'x' || c == 'X') + base = 16; + else + ungetc(c); + } + else + ungetc(c); + for(;;){ + c = getc(); + if(!r && (c == 'r' || c == 'R')){ + if(f || e) + error(nil, "bad base"); + r = 1; + base = int v; + if(base < 2 || base > 36) + error(nil, "bad base"); + v = big 0; + continue; + } + if(c == '.'){ + if(f || e) + error(nil, "bad real"); + f = 1; + continue; + } + if(base == 10 && (c == 'e' || c == 'E')){ + if(e) + error(nil, "bad E part"); + e = 1; + exp = lexe(base); + continue; + } + cc := basev(c, base); + if(cc < 0){ + ungetc(c); + break; + } + v = big base*v+big cc; + if(f) + f++; + } + lexval = real v; + if(f) + lexval /= real base**(f-1); + if(exp){ + if(exp > 0) + lexval *= real base**exp; + else + lexval *= maths->pow(real base, real exp); + } + return Onum; +} + +lexid(): int +{ + sp := ""; + for(;;){ + c := getc(); + if(c >= 'a' && c <= 'z' || c >= 'A' && c <= 'Z' || c >= '0' && c <= '9' || c >= 'α' && c <= 'ω' || c >= 'Α' && c <= 'Ω' || c == '_') + sp[len sp] = c; + else{ + ungetc(c); + break; + } + } + lexsym = enter(sp, Oident); + return lexsym.kind; +} + +follow(c: int, c1: int, c2: int): int +{ + nc := getc(); + if(nc == c) + return c1; + ungetc(nc); + return c2; +} + +skip() +{ + if((t := buft) != Olast){ + lex(); + if(t == Onl) + return; + } + for(;;){ + c := getc(); + if(c == Eof){ + ungetc(c); + return; + } + if(c == '\n'){ + lineno++; + return; + } + } +} + +lex(): int +{ + lexes++; + if((t := buft) != Olast){ + buft = Olast; + if(t == Onl) + lineno++; + return t; + } + for(;;){ + case(c := getc()){ + Eof => + return Oeof; + '#' => + while((c = getc()) != '\n'){ + if(c == Eof) + raise Eeof; + } + lineno++; + '\n' => + lineno++; + return Onl; + ' ' or + '\t' or + '\r' or + '\v' => + ; + '"' => + return lexstring(); + '\'' => + return lexchar(); + '0' to '9' => + ungetc(c); + return lexnum(); + 'a' to 'z' or + 'A' to 'Z' or + 'α' to 'ω' or + 'Α' to 'Ω' or + '_' => + ungetc(c); + return lexid(); + '+' => + c = getc(); + if(c == '=') + return Oadde; + ungetc(c); + return follow('+', Oinc, Oadd); + '-' => + c = getc(); + if(c == '=') + return Osube; + if(c == '>') + return Oimp; + ungetc(c); + return follow('-', Odec, Osub); + '*' => + c = getc(); + if(c == '=') + return Omule; + if(c == '*') + return follow('=', Oexpe, Oexp); + ungetc(c); + return Omul; + '/' => + c = getc(); + if(c == '=') + return Odive; + if(c == '/') + return follow('=', Oidive, Oidiv); + ungetc(c); + return Odiv; + '%' => + return follow('=', Omode, Omod); + '&' => + c = getc(); + if(c == '=') + return Oande; + ungetc(c); + return follow('&', Oandand, Oand); + '|' => + c = getc(); + if(c == '=') + return Oore; + ungetc(c); + return follow('|', Ooror, Oor); + '^' => + return follow('=', Oxore, Oxor); + '=' => + return follow('=', Oeq, Oas); + '!' => + return follow('=', One, Oexc); + '>' => + c = getc(); + if(c == '=') + return Oge; + if(c == '>') + return follow('=', Orshe, Orsh); + ungetc(c); + return Ogt; + '<' => + c = getc(); + if(c == '=') + return Ole; + if(c == '<') + return follow('=', Olshe, Olsh); + if(c == '-') + return follow('>', Oiff, Oimpby); + ungetc(c); + return Olt; + '(' => + return Olbr; + ')' => + return Orbr; + '{' => + return Olcbr; + '}' => + return Orcbr; + '~' => + return Ocom; + '.' => + ungetc(c); + return lexnum(); + ',' => + return Ocomma; + '?' => + return Oquest; + ':' => + return follow('=', Odas, Ocolon); + ';' => + return Oscolon; + '↑' => + return Onand; + '↓' => + return Onor; + '∞' => + lexval = Infinity; + return Onum; + * => + error(nil, sys->sprint("bad character %c", c)); + } + } +} + +unlex(t: int) +{ + lexes--; + buft = t; + if(t == Onl) + lineno--; +} + +mustbe(t: int) +{ + nt := lex(); + if(nt != t) + error(nil, sys->sprint("expected %s not %s", opstring(t), opstring(nt))); +} + +consume(t: int) +{ + nt := lex(); + if(nt != t) + unlex(nt); +} + +elex(): int +{ + t := lex(); + if(binary(t)) + return t; + if(hexp(t)){ + unlex(t); + return Oscomma; + } + return t; +} + +hexp(o: int): int +{ + return preunary(o) || o == Olbr || atom(o); +} + +atom(o: int): int +{ + return o >= Ostring && o <= Olfun; +} + +asop(o: int): int +{ + return o == Oas || o == Odas || o >= Oadde && o <= Orshe || o >= Oinc && o <= Opostdec; +} + +preunary(o: int): int +{ + return ops[o]&Preunary; +} + +postunary(o: int): int +{ + return ops[o]&Postunary; +} + +binary(o: int): int +{ + return ops[o]&Binary; +} + +prec(o: int): int +{ + return ops[o]&Prec; +} + +assoc(o: int): int +{ + return ops[o]&Assoc; +} + +rassoc(o: int): int +{ + return ops[o]&Rassoc; +} + +preop(o: int): int +{ + case(o){ + Oadd => return Oplus; + Osub => return Ominus; + Oinc => return Opreinc; + Odec => return Opredec; + Oexc => return Onot; + } + return o; +} + +postop(o: int): int +{ + case(o){ + Oinc => return Opostinc; + Odec => return Opostdec; + Oexc => return Ofact; + } + return o; +} + +prtree(p: ref Node, in: int) +{ + if(p == nil) + return; + for(i := 0; i < in; i++) + sys->print(" "); + sys->print("%s ", opstring(p.op)); + case(p.op){ + Ostring => + sys->print("%s", p.str); + Onum => + sys->print("%g", p.val); + Ocon or + Ovar => + sys->print("%s(%g)", p.dec.sym.name, p.dec.val); + Ofun or + Olfun => + sys->print("%s", p.dec.sym.name); + } + sys->print("\n"); + # sys->print(" - %d\n", p.src); + prtree(p.left, in+1); + prtree(p.right, in+1); +} + +tree(o: int, l: ref Node, r: ref Node): ref Node +{ + p := ref Node; + p.op = o; + p.left = l; + p.right = r; + p.src = lineno; + if(asop(o)){ + if(o >= Oadde && o <= Orshe){ + p = tree(Oas, l, p); + p.right.op += Oadd-Oadde; + } + } + return p; +} + +itree(n: int): ref Node +{ + return vtree(real n); +} + +vtree(v: real): ref Node +{ + n := tree(Onum, nil, nil); + n.val = v; + return n; +} + +ltree(s: string, a: ref Node): ref Node +{ + n := tree(Olfun, a, nil); + n.dec = lookup(s).dec; + return n; +} + +ptree(n: ref Node, p: real): ref Node +{ + if(isinteger(p)){ + i := int p; + if(i == 0) + return itree(1); + if(i == 1) + return n; + if(i == -1) + return tree(Oinv, n, nil); + if(i < 0) + return tree(Oinv, tree(Oexp, n, itree(-i)), nil); + } + return tree(Oexp, n, vtree(p)); +} + +iscon(n: ref Node): int +{ + return n.op == Onum || n.op == Ocon; +} + +iszero(n: ref Node): int +{ + return iscon(n) && eval(n) == 0.0; +} + +isone(n: ref Node): int +{ + return iscon(n) && eval(n) == 1.0; +} + +isnan(n: ref Node): int +{ + return iscon(n) && maths->isnan(eval(n)); +} + +isinf(n: ref Node): int +{ + return iscon(n) && (v := eval(n)) == Infinity || v == -Infinity; +} + +stat(scope: int): ref Node +{ + e1, e2, e3, e4: ref Node; + + consume(Onl); + t := lex(); + case(t){ + Olcbr => + if(scope) + pushscope(); + for(;;){ + e2 = stat(1); + if(e1 == nil) + e1 = e2; + else + e1 = tree(Ocomma, e1, e2); + consume(Onl); + t = lex(); + if(t == Oeof) + raise Eeof; + if(t == Orcbr) + break; + unlex(t); + } + if(scope) + popscope(); + return e1; + Oprint or + Oread or + Oret => + if(t == Oret && !infn) + error(nil, "return not in fn"); + e1= tree(t, expr(0, 1), nil); + consume(Oscolon); + if(t == Oread) + allvar(e1.left); + return e1; + Oif => + # mustbe(Olbr); + e1 = expr(0, 1); + # mustbe(Orbr); + e2 = stat(1); + e3 = nil; + consume(Onl); + t = lex(); + if(t == Oelse) + e3 = stat(1); + else + unlex(t); + return tree(Oif, e1, tree(Ocomma, e2, e3)); + Ofor => + inloop++; + mustbe(Olbr); + e1 = expr(0, 1); + mustbe(Oscolon); + e2 = expr(0, 1); + mustbe(Oscolon); + e3 = expr(0, 1); + mustbe(Orbr); + e4 = stat(1); + inloop--; + return tree(Ocomma, e1, tree(Ofor, e2, tree(Ocomma, e4, e3))); + Owhile => + inloop++; + # mustbe(Olbr); + e1 = expr(0, 1); + # mustbe(Orbr); + e2 = stat(1); + inloop--; + return tree(Ofor, e1, tree(Ocomma, e2, nil)); + Odo => + inloop++; + e1 = stat(1); + consume(Onl); + mustbe(Owhile); + # mustbe(Olbr); + e2 = expr(0, 1); + # mustbe(Orbr); + consume(Oscolon); + inloop--; + return tree(Odo, e1, e2); + Obreak or + Ocont or + Oexit => + if((t == Obreak || t == Ocont) && !inloop) + error(nil, "break/continue not in loop"); + consume(Oscolon); + return tree(t, nil, nil); + Ofn => + if(infn) + error(nil, "nested functions not allowed"); + infn++; + mustbe(Oident); + s := lexsym; + d := mkdec(s, Ofun, 1); + d.code = tree(Ofn, nil, nil); + pushscope(); + (d.na, d.code.left) = args(0); + allvar(d.code.left); + pushparams(d.code.left); + d.code.right = stat(0); + popscope(); + infn--; + return d.code; + Oinclude => + e1 = expr(0, 0); + if(e1.op != Ostring) + error(nil, "bad include file"); + consume(Oscolon); + doinclude(e1.str); + return nil; + * => + unlex(t); + e1 = expr(0, 1); + consume(Oscolon); + if(debug) + prnode(e1); + return e1; + } + return nil; +} + +ckstat(n: ref Node, parop: int, pr: int) +{ + if(n == nil) + return; + pr |= n.op == Oprint; + ckstat(n.left, n.op, pr); + ckstat(n.right, n.op, pr); + case(n.op){ + Ostring => + if(!pr || parop != Oprint && parop != Ocomma) + error(n, "illegal string operation"); + } +} + +pexp(e: ref Node): int +{ + if(e == nil) + return 0; + if(e.op == Ocomma) + return pexp(e.right); + return e.op >= Ostring && e.op <= Oiff && !asop(e.op); +} + +expr(p: int, zok: int): ref Node +{ + n := exp(p, zok); + ckexp(n, Onothing); + return n; +} + +exp(p: int, zok: int): ref Node +{ + l := prim(zok); + if(l == nil) + return nil; + while(binary(t := elex()) && (o := prec(t)) >= p){ + if(rassoc(t)) + r := exp(o, 0); + else + r = exp(o+1, 0); + if(t == Oscomma) + t = Ocomma; + l = tree(t, l, r); + } + if(t != Oscomma) + unlex(t); + return l; +} + +prim(zok: int): ref Node +{ + p: ref Node; + na: int; + + t := lex(); + if(preunary(t)){ + t = preop(t); + return tree(t, exp(prec(t), 0), nil); + } + case(t){ + Olbr => + p = exp(0, zok); + mustbe(Orbr); + Ostring => + p = tree(t, nil, nil); + p.str = lexstr; + Onum => + p = tree(t, nil ,nil); + p.val = lexval; + Oident => + s := lexsym; + d := s.dec; + if(d == nil) + d = mkdec(s, Ovar, 0); + case(t = d.kind){ + Ocon or + Ovar => + p = tree(t, nil, nil); + p.dec = d; + Ofun or + Olfun => + p = tree(t, nil, nil); + p.dec = d; + (na, p.left) = args(prec(t)); + if(!(t == Olfun && d.val == real Osolve && na == 2)) + if(na != d.na) + error(p, "wrong number of arguments"); + if(t == Olfun){ + case(int d.val){ + Osigma or + Opi or + Ocfrac or + Ointeg => + if((op := p.left.left.left.op) != Oas && op != Odas) + error(p.left, "expression not an assignment"); + Oderiv => + if((op := p.left.left.op) != Oas && op != Odas) + error(p.left, "expression not an assignment"); + } + } + } + * => + unlex(t); + if(!zok) + error(nil, "missing expression"); + return nil; + } + while(postunary(t = lex())){ + t = postop(t); + p = tree(t, p, nil); + } + unlex(t); + return p; +} + +ckexp(n: ref Node, parop: int) +{ + if(n == nil) + return; + o := n.op; + l := n.left; + r := n.right; + if(asop(o)) + var(l); + case(o){ + Ovar => + s := n.dec.sym; + d := s.dec; + if(d == nil){ + if(strict) + error(n, sys->sprint("%s undefined", s.name)); + d = mkdec(s, Ovar, 1); + } + n.dec = d; + Odas => + ckexp(r, o); + l.dec = mkdec(l.dec.sym, Ovar, 1); + * => + ckexp(l, o); + ckexp(r, o); + if(o == Oquest && r.op != Ocolon) + error(n, "bad '?' operator"); + if(o == Ocolon && parop != Oquest) + error(n, "bad ':' operator"); + } +} + +commas(n: ref Node): int +{ + if(n == nil || n.op == Ofun || n.op == Olfun) + return 0; + c := commas(n.left)+commas(n.right); + if(n.op == Ocomma) + c++; + return c; +} + +allvar(n: ref Node) +{ + if(n == nil) + return; + if(n.op == Ocomma){ + allvar(n.left); + allvar(n.right); + return; + } + var(n); +} + +args(p: int): (int, ref Node) +{ + if(!p) + mustbe(Olbr); + a := exp(p, 1); + if(!p) + mustbe(Orbr); + na := 0; + if(a != nil) + na = commas(a)+1; + return (na, a); +} + +hash(s: string): int +{ + l := len s; + h := 4104; + for(i := 0; i < l; i++) + h = 1729*h ^ s[i]; + if(h < 0) + h = -h; + return h&(Hash-1); +} + +enter(sp: string, k: int): ref Sym +{ + for(s := syms[hash(sp)]; s != nil; s = s.next){ + if(sp == s.name) + return s; + } + s = ref Sym; + s.name = sp; + s.kind = k; + h := hash(sp); + s.next = syms[h]; + syms[h] = s; + return s; +} + +lookup(sp: string): ref Sym +{ + return enter(sp, Oident); +} + +mkdec(s: ref Sym, k: int, dec: int): ref Dec +{ + d := ref Dec; + d.kind = k; + d.val = 0.0; + d.na = 0; + d.sym = s; + d.scope = 0; + if(dec) + pushdec(d); + return d; +} + +adddec(sp: string, k: int, v: real, n: int): ref Dec +{ + d := mkdec(enter(sp, Oident), k, 1); + d.val = v; + d.na = n; + return d; +} + +scope: int; +curscope: ref Dec; +scopes: list of ref Dec; + +pushscope() +{ + scope++; + scopes = curscope :: scopes; + curscope = nil; +} + +popscope() +{ + popdecs(); + curscope = hd scopes; + scopes = tl scopes; + scope--; +} + +pushparams(n: ref Node) +{ + if(n == nil) + return; + if(n.op == Ocomma){ + pushparams(n.left); + pushparams(n.right); + return; + } + n.dec = mkdec(n.dec.sym, Ovar, 1); +} + +pushdec(d: ref Dec) +{ + if(0 && debug) + sys->print("dec %s scope %d\n", d.sym.name, scope); + d.scope = scope; + s := d.sym; + if(s.dec != nil && s.dec.scope == scope) + error(nil, sys->sprint("redeclaration of %s", s.name)); + d.old = s.dec; + s.dec = d; + d.next = curscope; + curscope = d; +} + +popdecs() +{ + nd: ref Dec; + for(d := curscope; d != nil; d = nd){ + d.sym.dec = d.old; + d.old = nil; + nd = d.next; + d.next = nil; + } + curscope = nil; +} + +estat(n: ref Node): (int, real) +{ + k: int; + v: real; + + if(n == nil) + return (Onothing, 0.0); + l := n.left; + r := n.right; + case(n.op){ + Ocomma => + (k, v) = estat(l); + if(k == Oexit || k == Oret || k == Obreak || k == Ocont) + return (k, v); + return estat(r); + Oprint => + v = print(l); + return (Onothing, v); + Oread => + v = read(l); + return (Onothing, v); + Obreak or + Ocont or + Oexit => + return (n.op, 0.0); + Oret => + return (Oret, eval(l)); + Oif => + v = eval(l); + if(int v) + return estat(r.left); + else if(r.right != nil) + return estat(r.right); + else + return (Onothing, v); + Ofor => + for(;;){ + v = eval(l); + if(!int v) + break; + (k, v) = estat(r.left); + if(k == Oexit || k == Oret) + return (k, v); + if(k == Obreak) + break; + if(r.right != nil) + v = eval(r.right); + } + return (Onothing, v); + Odo => + for(;;){ + (k, v) = estat(l); + if(k == Oexit || k == Oret) + return (k, v); + if(k == Obreak) + break; + v = eval(r); + if(!int v) + break; + } + return (Onothing, v); + * => + return (Onothing, eval(n)); + } + return (Onothing, 0.0); +} + +eval(e: ref Node): real +{ + lv, rv: real; + + if(e == nil) + return 1.0; + o := e.op; + l := e.left; + r := e.right; + if(o != Ofun && o != Olfun) + lv = eval(l); + if(o != Oandand && o != Ooror && o != Oquest) + rv = eval(r); + case(o){ + Ostring => + return 0.0; + Onum => + return e.val; + Ocon or + Ovar => + return e.dec.val; + Ofun => + return call(e.dec, l); + Olfun => + return libfun(int e.dec.val, l); + Oadd => + return lv+rv; + Osub => + return lv-rv; + Omul => + return lv*rv; + Odiv => + return lv/rv; + Omod => + return real (big lv%big rv); + Oidiv => + return real (big lv/big rv); + Oand => + return real (big lv&big rv); + Oor => + return real (big lv|big rv); + Oxor => + return real (big lv^big rv); + Olsh => + return real (big lv<<int rv); + Orsh => + return real (big lv>>int rv); + Oeq => + return real (lv == rv); + One => + return real (lv != rv); + Ogt => + return real (lv > rv); + Olt => + return real (lv < rv); + Oge => + return real (lv >= rv); + Ole => + return real (lv <= rv); + Opreinc => + l.dec.val += 1.0; + return l.dec.val; + Opostinc => + l.dec.val += 1.0; + return l.dec.val-1.0; + Opredec => + l.dec.val -= 1.0; + return l.dec.val; + Opostdec => + l.dec.val -= 1.0; + return l.dec.val+1.0; + Oexp => + if(isinteger(rv) && rv >= 0.0) + return lv**int rv; + return maths->pow(lv, rv); + Oandand => + if(!int lv) + return lv; + return eval(r); + Ooror => + if(int lv) + return lv; + return eval(r); + Onot => + return real !int lv; + Ofact => + if(isinteger(lv) && lv >= 0.0){ + n := int lv; + lv = 1.0; + for(i := 2; i <= n; i++) + lv *= real i; + return lv; + } + return gamma(lv+1.0); + Ocom => + return real ~big lv; + Oas or + Odas => + l.dec.val = rv; + return rv; + Oplus => + return lv; + Ominus => + return -lv; + Oinv => + return 1.0/lv; + Ocomma => + return rv; + Oquest => + if(int lv) + return eval(r.left); + else + return eval(r.right); + Onand => + return real !(int lv&int rv); + Onor => + return real !(int lv|int rv); + Oimp => + return real (!int lv|int rv); + Oimpby => + return real (int lv|!int rv); + Oiff => + return real !(int lv^int rv); + * => + fatal(sys->sprint("case %s in eval", opstring(o))); + } + return 0.0; +} + +var(e: ref Node) +{ + if(e == nil || e.op != Ovar || e.dec.kind != Ovar) + error(e, "expected a variable"); +} + +libfun(o: int, a: ref Node): real +{ + a1, a2: real; + + case(o){ + Osolve => + return solve(a); + Osigma or + Opi or + Ocfrac => + return series(o, a); + Oderiv => + return differential(a); + Ointeg => + return integral(a); + } + v := 0.0; + if(a != nil && a.op == Ocomma){ + a1 = eval(a.left); + a2 = eval(a.right); + } + else + a1 = eval(a); + case(o){ + Olog => + v = maths->log(a1); + Olog10 => + v = maths->log10(a1); + Olog2 => + v = maths->log(a1)/maths->log(2.0); + Ologb => + v = maths->log(a1)/maths->log(a2); + Oexpf => + v = maths->exp(a1); + Opow => + v = maths->pow(a1, a2); + Osqrt => + v = maths->sqrt(a1); + Ocbrt => + v = maths->cbrt(a1); + Ofloor => + v = maths->floor(a1); + Oceil => + v = maths->ceil(a1); + Omin => + v = maths->fmin(a1, a2); + Omax => + v = maths->fmax(a1, a2); + Oabs => + v = maths->fabs(a1); + Ogamma => + v = gamma(a1); + Osign => + if(a1 > 0.0) + v = 1.0; + else if(a1 < 0.0) + v = -1.0; + else + v = 0.0; + Oint => + (vi, nil) := maths->modf(a1); + v = real vi; + Ofrac => + (nil, v) = maths->modf(a1); + Oround => + v = maths->rint(a1); + Oerf => + v = maths->erf(a1); + Osin => + v = maths->sin(D2R(a1)); + Ocos => + v = maths->cos(D2R(a1)); + Otan => + v = maths->tan(D2R(a1)); + Oasin => + v = R2D(maths->asin(a1)); + Oacos => + v = R2D(maths->acos(a1)); + Oatan => + v = R2D(maths->atan(a1)); + Oatan2 => + v = R2D(maths->atan2(a1, a2)); + Osinh => + v = maths->sinh(a1); + Ocosh => + v = maths->cosh(a1); + Otanh => + v = maths->tanh(a1); + Oasinh => + v = maths->asinh(a1); + Oacosh => + v = maths->acosh(a1); + Oatanh => + v = maths->atanh(a1); + Orand => + v = real rand->rand(Big)/real Big; + * => + fatal(sys->sprint("case %s in libfun", opstring(o))); + } + return v; +} + +series(o: int, a: ref Node): real +{ + p0, p1, q0, q1: real; + + l := a.left; + r := a.right; + if(o == Osigma) + v := 0.0; + else if(o == Opi) + v = 1.0; + else{ + p0 = q1 = 0.0; + p1 = q0 = 1.0; + v = Infinity; + } + i := l.left.left.dec; + ov := i.val; + i.val = eval(l.left.right); + eq := 0; + for(;;){ + rv := eval(l.right); + if(i.val > rv) + break; + lv := v; + ev := eval(r); + if(o == Osigma) + v += ev; + else if(o == Opi) + v *= ev; + else{ + t := ev*p1+p0; + p0 = p1; + p1 = t; + t = ev*q1+q0; + q0 = q1; + q1 = t; + v = p1/q1; + } + if(v == lv && rv == Infinity){ + eq++; + if(eq > 100) + break; + } + else + eq = 0; + i.val += 1.0; + } + i.val = ov; + return v; +} + +pushe(a: ref Node, l: list of real): list of real +{ + if(a == nil) + return l; + if(a.op == Ocomma){ + l = pushe(a.left, l); + return pushe(a.right, l); + } + l = eval(a) :: l; + return l; +} + +pusha(f: ref Node, l: list of real, nl: list of real): (list of real, list of real) +{ + if(f == nil) + return (l, nl); + if(f.op == Ocomma){ + (l, nl) = pusha(f.left, l, nl); + return pusha(f.right, l, nl); + } + l = f.dec.val :: l; + f.dec.val = hd nl; + return (l, tl nl); +} + +pop(f: ref Node, l: list of real): list of real +{ + if(f == nil) + return l; + if(f.op == Ocomma){ + l = pop(f.left, l); + return pop(f.right, l); + } + f.dec.val = hd l; + return tl l; +} + +rev(l: list of real): list of real +{ + nl: list of real; + + for( ; l != nil; l = tl l) + nl = hd l :: nl; + return nl; +} + +call(d: ref Dec, a: ref Node): real +{ + l: list of real; + + nl := rev(pushe(a, nil)); + (l, nil) = pusha(d.code.left, nil, nl); + l = rev(l); + (k, v) := estat(d.code.right); + l = pop(d.code.left, l); + if(k == Oexit) + exit; + return v; +} + +print(n: ref Node): real +{ + if(n == nil) + return 0.0; + if(n.op == Ocomma){ + print(n.left); + return print(n.right); + } + if(n.op == Ostring){ + sys->print("%s", n.str); + return 0.0; + } + v := eval(n); + printnum(v, ""); + return v; +} + +read(n: ref Node): real +{ + bio: ref Iobuf; + + if(n == nil) + return 0.0; + if(n.op == Ocomma){ + read(n.left); + return read(n.right); + } + sys->print("%s ? ", n.dec.sym.name); + if(!stdin){ + bio = bufio->fopen(sys->fildes(0), Sys->OREAD); + stack(nil, bio); + } + lexnum(); + consume(Onl); + n.dec.val = lexval; + if(!stdin && bin == bio) + unstack(); + return n.dec.val; +} + +isint(v: real): int +{ + return v >= -real Maxint && v <= real Maxint; +} + +isinteger(v: real): int +{ + return v == real int v && isint(v); +} + +split(v: real): (int, real) +{ + # v >= 0.0 + n := int v; + if(real n > v) + n--; + return (n, v-real n); +} + +n2c(n: int): int +{ + if(n < 10) + return n+'0'; + return n-10+'a'; +} + +gamma(v: real): real +{ + (s, lg) := maths->lgamma(v); + return real s*maths->exp(lg); +} + +D2R(a: real): real +{ + if(deg.val != 0.0) + a *= Pi/180.0; + return a; +} + +R2D(a: real): real +{ + if(deg.val != 0.0) + a /= Pi/180.0; + return a; +} + +side(n: ref Node): int +{ + if(n == nil) + return 0; + if(asop(n.op) || n.op == Ofun) + return 1; + return side(n.left) || side(n.right); +} + +sametree(n1: ref Node, n2: ref Node): int +{ + if(n1 == n2) + return 1; + if(n1 == nil || n2 == nil) + return 0; + if(n1.op != n2.op) + return 0; + case(n1.op){ + Ostring => + return n1.str == n2.str; + Onum => + return n1.val == n2.val; + Ocon or + Ovar => + return n1.dec == n2.dec; + Ofun or + Olfun => + return n1.dec == n2.dec && sametree(n1.left, n2.left); + * => + return sametree(n1.left, n2.left) && sametree(n1.right, n2.right); + } + return 0; +} + +simplify(n: ref Node): ref Node +{ + if(n == nil) + return nil; + op := n.op; + l := n.left = simplify(n.left); + r := n.right = simplify(n.right); + if(l != nil && iscon(l) && (r == nil || iscon(r))){ + if(isnan(l)) + return l; + if(r != nil && isnan(r)) + return r; + return vtree(eval(n)); + } + case(op){ + Onum or + Ocon or + Ovar or + Olfun or + Ocomma => + return n; + Oplus => + return l; + Ominus => + if(l.op == Ominus) + return l.left; + Oinv => + if(l.op == Oinv) + return l.left; + Oadd => + if(iszero(l)) + return r; + if(iszero(r)) + return l; + if(sametree(l, r)) + return tree(Omul, itree(2), l); + Osub => + if(iszero(l)) + return simplify(tree(Ominus, r, nil)); + if(iszero(r)) + return l; + if(sametree(l, r)) + return itree(0); + Omul => + if(iszero(l)) + return l; + if(iszero(r)) + return r; + if(isone(l)) + return r; + if(isone(r)) + return l; + if(sametree(l, r)) + return tree(Oexp, l, itree(2)); + Odiv => + if(iszero(l)) + return l; + if(iszero(r)) + return vtree(Infinity); + if(isone(l)) + return ptree(r, -1.0); + if(isone(r)) + return l; + if(sametree(l, r)) + return itree(1); + Oexp => + if(iszero(l)) + return l; + if(iszero(r)) + return itree(1); + if(isone(l)) + return l; + if(isone(r)) + return l; + * => + fatal(sys->sprint("case %s in simplify", opstring(op))); + } + return n; +} + +deriv(n: ref Node, d: ref Dec): ref Node +{ + if(n == nil) + return nil; + op := n.op; + l := n.left; + r := n.right; + case(op){ + Onum or + Ocon => + n = itree(0); + Ovar => + if(d == n.dec) + n = itree(1); + else + n = itree(0); + Olfun => + case(int n.dec.val){ + Olog => + n = ptree(l, -1.0); + Olog10 => + n = ptree(tree(Omul, l, vtree(Ln10)), -1.0); + Olog2 => + n = ptree(tree(Omul, l, vtree(Ln2)), -1.0); + Oexpf => + n = n; + Opow => + return deriv(tree(Oexp, l.left, l.right), d); + Osqrt => + return deriv(tree(Oexp, l, vtree(0.5)), d); + Ocbrt => + return deriv(tree(Oexp, l, vtree(1.0/3.0)), d); + Osin => + n = ltree("cos", l); + Ocos => + n = tree(Ominus, ltree("sin", l), nil); + Otan => + n = ptree(ltree("cos", l), -2.0); + Oasin => + n = ptree(tree(Osub, itree(1), ptree(l, 2.0)), -0.5); + Oacos => + n = tree(Ominus, ptree(tree(Osub, itree(1), ptree(l, 2.0)), -0.5), nil); + Oatan => + n = ptree(tree(Oadd, itree(1), ptree(l, 2.0)), -1.0); + Osinh => + n = ltree("cosh", l); + Ocosh => + n = ltree("sinh", l); + Otanh => + n = ptree(ltree("cosh", l), -2.0); + Oasinh => + n = ptree(tree(Oadd, itree(1), ptree(l, 2.0)), -0.5); + Oacosh => + n = ptree(tree(Osub, ptree(l, 2.0), itree(1)), -0.5); + Oatanh => + n = ptree(tree(Osub, itree(1), ptree(l, 2.0)), -1.0); + * => + return vtree(Nan); + } + return tree(Omul, n, deriv(l, d)); + Oplus or + Ominus => + n = tree(op, deriv(l, d), nil); + Oinv => + n = tree(Omul, tree(Ominus, ptree(l, -2.0), nil), deriv(l, d)); + Oadd or + Osub or + Ocomma => + n = tree(op, deriv(l, d), deriv(r, d)); + Omul => + n = tree(Oadd, tree(Omul, deriv(l, d), r), tree(Omul, l, deriv(r, d))); + Odiv => + n = tree(Osub, tree(Omul, deriv(l, d), r), tree(Omul, l, deriv(r, d))); + n = tree(Odiv, n, ptree(r, 2.0)); + Oexp => + nn := tree(Oadd, tree(Omul, deriv(l, d), tree(Odiv, r, l)), tree(Omul, ltree("log", l), deriv(r, d))); + n = tree(Omul, n, nn); + * => + n = vtree(Nan); + } + return n; +} + +derivative(n: ref Node, d: ref Dec): ref Node +{ + n = simplify(deriv(n, d)); + if(isnan(n)) + error(n, "no derivative"); + if(debug) + prnode(n); + return n; +} + +newton(f: ref Node, e: ref Node, d: ref Dec, v1: real, v2: real): (int, real) +{ + v := (v1+v2)/2.0; + lv := 0.0; + its := 0; + for(;;){ + lv = v; + d.val = v; + v = eval(e); + # if(v < v1 || v > v2) + # return (0, 0.0); + if(maths->isnan(v)) + return (0, 0.0); + if(its > 100 || fabs(v-lv) < Eps) + break; + its++; + } + if(fabs(v-lv) > Bigeps || fabs(eval(f)) > Bigeps) + return (0, 0.0); + return (1, v); +} + +solve(n: ref Node): real +{ + d: ref Dec; + + if(n == nil) + return Nan; + if(n.op == Ocomma){ # solve(..., var) + var(n.right); + d = n.right.dec; + n = n.left; + if(!varmem(n, d)) + error(n, "variable not in equation"); + } + else{ + d = findvar(n, nil); + if(d == nil) + error(n, "variable missing"); + if(d == errdec) + error(n, "one variable only required"); + } + if(n.op == Oeq) + n.op = Osub; + dn := derivative(n, d); + var := tree(Ovar, nil, nil); + var.dec = d; + nr := tree(Osub, var, tree(Odiv, n, dn)); + ov := d.val; + lim := lookup(Limit).dec.val; + step := lookup(Step).dec.val; + rval := Infinity; + d.val = -lim-step; + v1 := 0.0; + v2 := eval(n); + for(v := -lim; v <= lim; v += step){ + d.val = v; + v1 = v2; + v2 = eval(n); + if(maths->isnan(v2)) # v == nan, v <= nan, v >= nan all give 1 + continue; + if(fabs(v2) < Eps){ + if(v >= -lim && v <= lim && v != rval){ + printnum(v, " "); + rval = v; + } + } + else if(v1*v2 <= 0.0){ + (f, rv) := newton(n, nr, var.dec, v-step, v); + if(f && rv >= -lim && rv <= lim && rv != rval){ + printnum(rv, " "); + rval = rv; + } + } + } + d.val = ov; + if(rval == Infinity) + error(n, "no roots found"); + else + sys->print("\n"); + return rval; +} + +differential(n: ref Node): real +{ + x := n.left.left.dec; + ov := x.val; + v := evalx(derivative(n.right, x), x, eval(n.left.right)); + x.val = ov; + return v; +} + +integral(n: ref Node): real +{ + l := n.left; + r := n.right; + x := l.left.left.dec; + ov := x.val; + a := eval(l.left.right); + b := eval(l.right); + h := b-a; + end := evalx(r, x, a) + evalx(r, x, b); + odd := even := 0.0; + oldarea := 0.0; + area := h*end/2.0; + for(i := 1; i < 1<<16; i <<= 1){ + even += odd; + odd = 0.0; + xv := a+h/2.0; + for(j := 0; j < i; j++){ + odd += evalx(r, x, xv); + xv += h; + } + h /= 2.0; + oldarea = area; + area = h*(end+4.0*odd+2.0*even)/3.0; + if(maths->isnan(area)) + error(n, "integral not found"); + if(fabs(area-oldarea) < Eps) + break; + } + if(fabs(area-oldarea) > Bigeps) + error(n, "integral not found"); + x.val = ov; + return area; +} + +evalx(n: ref Node, d: ref Dec, v: real): real +{ + d.val = v; + return eval(n); +} + +findvar(n: ref Node, d: ref Dec): ref Dec +{ + if(n == nil) + return d; + d = findvar(n.left, d); + d = findvar(n.right, d); + if(n.op == Ovar){ + if(d == nil) + d = n.dec; + if(n.dec != d) + d = errdec; + } + return d; +} + +varmem(n: ref Node, d: ref Dec): int +{ + if(n == nil) + return 0; + if(n.op == Ovar) + return d == n.dec; + return varmem(n.left, d) || varmem(n.right, d); +} + +fabs(r: real): real +{ + if(r < 0.0) + return -r; + return r; +} + +cvt(v: real, base: int): string +{ + if(base == 10) + return sys->sprint("%g", v); + neg := 0; + if(v < 0.0){ + neg = 1; + v = -v; + } + if(!isint(v)){ + n := 0; + lg := maths->log(v)/maths->log(real base); + if(lg < 0.0){ + (n, nil) = split(-lg); + v *= real base**n; + n = -n; + } + else{ + (n, nil) = split(lg); + v /= real base**n; + } + s := cvt(v, base) + "E" + string n; + if(neg) + s = "-" + s; + return s; + } + (n, f) := split(v); + s := ""; + do{ + r := n%base; + n /= base; + s[len s] = n2c(r); + }while(n != 0); + ls := len s; + for(i := 0; i < ls/2; i++){ + t := s[i]; + s[i] = s[ls-1-i]; + s[ls-1-i] = t; + } + if(f != 0.0){ + s[len s] = '.'; + for(i = 0; i < 16 && f != 0.0; i++){ + f *= real base; + (n, f) = split(f); + s[len s] = n2c(n); + } + } + s = string base + "r" + s; + if(neg) + s = "-" + s; + return s; +} + +printnum(v: real, s: string) +{ + base := int pbase.val; + if(!isinteger(pbase.val) || base < 2 || base > 36) + base = 10; + sys->print("%s%s", cvt(v, base), s); + if(bits){ + r := array[1] of real; + b := array[8] of byte; + r[0] = v; + maths->export_real(b, r); + for(i := 0; i < 8; i++) + sys->print("%2.2x ", int b[i]); + sys->print("\n"); + } +} + +Left, Right, Pre, Post: con 1<<iota; + +lspace := array[] of { 0, 0, 2, 3, 4, 5, 0, 0, 0, 9, 10, 0, 0, 0, 0, 0, 0, 0 }; +rspace := array[] of { 0, 1, 2, 3, 4, 5, 0, 0, 0, 9, 10, 0, 0, 0, 0, 0, 0, 0 }; + +preced(op1: int, op2: int, s: int): int +{ + br := 0; + p1 := prec(op1); + p2 := prec(op2); + if(p1 > p2) + br = 1; + else if(p1 == p2){ + if(op1 == op2){ + if(rassoc(op1)) + br = s == Left; + else + br = s == Right && !assoc(op1); + } + else{ + if(rassoc(op1)) + br = s == Left; + else + br = s == Right && op1 != Oadd; + if(postunary(op1) && preunary(op2)) + br = 1; + } + } + return br; +} + +prnode(n: ref Node) +{ + pnode(n, Onothing, Pre); + sys->print("\n"); +} + +pnode(n: ref Node, opp: int, s: int) +{ + if(n == nil) + return; + op := n.op; + if(br := preced(opp, op, s)) + sys->print("("); + if(op == Oas && n.right.op >= Oadd && n.right.op <= Orsh && n.left == n.right.left){ + pnode(n.left, op, Left); + sys->print(" %s ", opstring(n.right.op+Oadde-Oadd)); + pnode(n.right.right, op, Right); + } + else if(binary(op)){ + p := prec(op); + pnode(n.left, op, Left); + if(lspace[p]) + sys->print(" "); + sys->print("%s", opstring(op)); + if(rspace[p]) + sys->print(" "); + pnode(n.right, op, Right); + } + else if(op == Oinv){ # cannot print postunary -1 + sys->print("%s", opstring(op)); + pnode(n.left, Odiv, Right); + } + else if(preunary(op)){ + sys->print("%s", opstring(op)); + pnode(n.left, op, Pre); + } + else if(postunary(op)){ + pnode(n.left, op, Post); + sys->print("%s", opstring(op)); + } + else{ + case(op){ + Ostring => + sys->print("%s", n.str); + Onum => + sys->print("%g", n.val); + Ocon or + Ovar => + sys->print("%s", n.dec.sym.name); + Ofun or + Olfun => + sys->print("%s(", n.dec.sym.name); + pnode(n.left, Onothing, Pre); + sys->print(")"); + * => + fatal(sys->sprint("bad op %s in pnode()", opstring(op))); + } + } + if(br) + sys->print(")"); +} diff --git a/appl/cmd/mc.b b/appl/cmd/mc.b index 265d548e..631c4cc1 100644 --- a/appl/cmd/mc.b +++ b/appl/cmd/mc.b @@ -1,2547 +1,145 @@ -implement Calculator; +implement Mc; include "sys.m"; sys: Sys; + open, read, fprint, fildes, tokenize, + ORDWR, OREAD, OWRITE: import sys; include "draw.m"; -include "arg.m"; - arg: Arg; + draw: Draw; + Font: import draw; include "bufio.m"; bufio: Bufio; Iobuf: import bufio; -include "math.m"; - maths: Math; -include "rand.m"; - rand: Rand; -include "daytime.m"; - daytime: Daytime; +include "env.m"; + env: Env; +include "arg.m"; -Calculator: module -{ +font: ref Font; +columns := 65; +tabwid := 0; +mintab := 1; + +Mc: module{ init: fn(nil: ref Draw->Context, argv: list of string); }; -init(nil: ref Draw->Context, args: list of string) +init(ctxt: ref Draw->Context, argv: list of string) { sys = load Sys Sys->PATH; - arg = load Arg Arg->PATH; - bufio = load Bufio Bufio->PATH; - maths = load Math Math->PATH; - rand = load Rand Rand->PATH; - daytime = load Daytime Daytime->PATH; - - maths->FPcontrol(0, Math->INVAL|Math->ZDIV|Math->OVFL|Math->UNFL|Math->INEX); - - rand->init(daytime->now()); - rand->init(rand->rand(Big)^rand->rand(Big)); - daytime = nil; - - arg->init(args); - while((c := arg->opt()) != 0){ - case(c){ - 'b' => - bits = 1; - 'd' => - debug = 1; - 's' => - strict = 1; - } - } - gargs = args = arg->argv(); - if(args == nil){ - stdin = 1; - bin = bufio->fopen(sys->fildes(0), Sys->OREAD); - } - else if(tl args == nil) - bin = bufio->open(hd args, Sys->OREAD); - - syms = array[Hash] of ref Sym; - - pushscope(); - for(i := 0; keyw[i].t0 != nil; i++) - enter(keyw[i].t0, keyw[i].t1); - for(i = 0; conw[i].t0 != nil; i++) - adddec(conw[i].t0, Ocon, conw[i].t1, 0); - for(i = 0; varw[i].t0 != nil; i++) - adddec(varw[i].t0, Ovar, varw[i].t1, 0); - for(i = 0; funw[i].t0 != nil; i++) - adddec(funw[i].t0, Olfun, real funw[i].t1, funw[i].t2); - - deg = lookup(Deg).dec; - pbase = lookup(Base).dec; - errdec = ref Dec; - - pushscope(); - for(;;){ - e: ref Node; - - { - t := lex(); - if(t == Oeof) - break; - unlex(t); - ls := lexes; - e = stat(1); - ckstat(e, Onothing, 0); - if(ls == lexes){ - t = lex(); - error(nil, sys->sprint("syntax error near %s", opstring(t))); - unlex(t); - } - consume(Onl); - } - exception ex{ - Eeof => - e = nil; - err("premature eof"); - skip(); - "*" => - e = nil; - err(ex); - skip(); - } - if(0 && debug) - prtree(e, 0); - if(e != nil && e.op != Ofn){ - (k, v) := (Onothing, 0.0); - { - (k, v) = estat(e); - } - exception ex{ - "*" => - e = nil; - err(ex); - } - if(pexp(e)) - printnum(v, "\n"); - if(k == Oexit) - exit; - } - } - popscope(); - popscope(); -} - -bits: int; -debug: int; -strict: int; - -None: con -2; -Eof: con -1; -Eeof: con "eof"; - -Hash: con 16; -Big: con 1<<30; -Maxint: con 16r7FFFFFFF; -Nan: con Math->NaN; -Infinity: con Math->Infinity; -Pi: con Math->Pi; -Eps: con 1E-10; -Bigeps: con 1E-2; -Ln2: con 0.6931471805599453; -Ln10: con 2.302585092994046; -Euler: con 2.71828182845904523536; -Gamma: con 0.57721566490153286060; -Phi: con 1.61803398874989484820; - -Oeof, -Ostring, Onum, Oident, Ocon, Ovar, Ofun, Olfun, -Oadd, Osub, Omul, Odiv, Omod, Oidiv, Oexp, Oand, Oor, Oxor, Olsh, Orsh, -Oadde, Osube, Omule, Odive, Omode, Oidive, Oexpe, Oande, Oore, Oxore, Olshe, Orshe, -Oeq, One, Ogt, Olt, Oge, Ole, -Oinc, Opreinc, Opostinc, Odec, Opredec, Opostdec, -Oandand, Ooror, -Oexc, Onot, Ofact, Ocom, -Oas, Odas, -Oplus, Ominus, Oinv, -Ocomma, Oscomma, Oquest, Ocolon, -Onand, Onor, Oimp, Oimpby, Oiff, -Olbr, Orbr, Olcbr, Orcbr, Oscolon, Onl, -Onothing, -Oprint, Oread, -Oif, Oelse, Ofor, Owhile, Odo, Obreak, Ocont, Oexit, Oret, Ofn, Oinclude, -Osigma, Opi, Ocfrac, Oderiv, Ointeg, Osolve, -Olog, Olog10, Olog2, Ologb, Oexpf, Opow, Osqrt, Ocbrt, Ofloor, Oceil, Omin, Omax, Oabs, Ogamma, Osign, Oint, Ofrac, Oround, Oerf, Oatan2, Osin, Ocos, Otan, Oasin, Oacos, Oatan, Osinh, Ocosh, Otanh, Oasinh, Oacosh, Oatanh, Orand, -Olast: con iota; - -Binary: con (1<<8); -Preunary: con (1<<9); -Postunary: con (1<<10); -Assoc: con (1<<11); -Rassoc: con (1<<12); -Prec: con Binary-1; - -opss := array[Olast] of -{ - "eof", - "string", - "number", - "identifier", - "constant", - "variable", - "function", - "library function", - "+", - "-", - "*", - "/", - "%", - "//", - "&", - "|", - "^", - "<<", - ">>", - "+=", - "-=", - "*=", - "/=", - "%=", - "//=", - "&=", - "|=", - "^=", - "<<=", - ">>=", - "==", - "!=", - ">", - "<", - ">=", - "<=", - "++", - "++", - "++", - "--", - "--", - "--", - "**", - "&&", - "||", - "!", - "!", - "!", - "~", - "=", - ":=", - "+", - "-", - "1/", - ",", - ",", - "?", - ":", - "↑", - "↓", - "->", - "<-", - "<->", - "(", - ")", - "{", - "}", - ";", - "\n", - "", -}; - -ops := array[Olast] of -{ - Oeof => 0, - Ostring => 17, - Onum => 17, - Oident => 17, - Ocon => 17, - Ovar => 17, - Ofun => 17, - Olfun => 17, - Oadd => 12|Binary|Assoc|Preunary, - Osub => 12|Binary|Preunary, - Omul => 13|Binary|Assoc, - Odiv => 13|Binary, - Omod => 13|Binary, - Oidiv => 13|Binary, - Oexp => 14|Binary|Rassoc, - Oand => 8|Binary|Assoc, - Oor => 6|Binary|Assoc, - Oxor => 7|Binary|Assoc, - Olsh => 11|Binary, - Orsh => 11|Binary, - Oadde => 2|Binary|Rassoc, - Osube => 2|Binary|Rassoc, - Omule => 2|Binary|Rassoc, - Odive => 2|Binary|Rassoc, - Omode => 2|Binary|Rassoc, - Oidive => 2|Binary|Rassoc, - Oexpe => 2|Binary|Rassoc, - Oande => 2|Binary|Rassoc, - Oore => 2|Binary|Rassoc, - Oxore => 2|Binary|Rassoc, - Olshe => 2|Binary|Rassoc, - Orshe => 2|Binary|Rassoc, - Oeq => 9|Binary, - One => 9|Binary, - Ogt => 10|Binary, - Olt => 10|Binary, - Oge => 10|Binary, - Ole => 10|Binary, - Oinc => 15|Rassoc|Preunary|Postunary, - Opreinc => 15|Rassoc|Preunary, - Opostinc => 15|Rassoc|Postunary, - Odec => 15|Rassoc|Preunary|Postunary, - Opredec => 15|Rassoc|Preunary, - Opostdec => 15|Rassoc|Postunary, - Oandand => 5|Binary|Assoc, - Ooror => 4|Binary|Assoc, - Oexc => 15|Rassoc|Preunary|Postunary, - Onot => 15|Rassoc|Preunary, - Ofact => 15|Rassoc|Postunary, - Ocom => 15|Rassoc|Preunary, - Oas => 2|Binary|Rassoc, - Odas => 2|Binary|Rassoc, - Oplus => 15|Rassoc|Preunary, - Ominus => 15|Rassoc|Preunary, - Oinv => 15|Rassoc|Postunary, - Ocomma => 1|Binary|Assoc, - Oscomma => 1|Binary|Assoc, - Oquest => 3|Binary|Rassoc, - Ocolon => 3|Binary|Rassoc, - Onand => 8|Binary, - Onor => 6|Binary, - Oimp => 9|Binary, - Oimpby => 9|Binary, - Oiff => 10|Binary|Assoc, - Olbr => 16, - Orbr => 16, - Onothing => 0, -}; - -Deg: con "degrees"; -Base: con "printbase"; -Limit: con "solvelimit"; -Step: con "solvestep"; - -keyw := array[] of -{ - ("include", Oinclude), - ("if", Oif), - ("else", Oelse), - ("for", Ofor), - ("while", Owhile), - ("do", Odo), - ("break", Obreak), - ("continue", Ocont), - ("exit", Oexit), - ("return", Oret), - ("print", Oprint), - ("read", Oread), - ("fn", Ofn), - ("", 0), -}; - -conw := array[] of -{ - ("π", Pi), - ("Pi", Pi), - ("e", Euler), - ("γ", Gamma), - ("Gamma", Gamma), - ("φ", Phi), - ("Phi", Phi), - ("∞", Infinity), - ("Infinity", Infinity), - ("NaN", Nan), - ("Nan", Nan), - ("nan", Nan), - ("", 0.0), -}; - -varw := array[] of -{ - (Deg, 0.0), - (Base, 10.0), - (Limit, 100.0), - (Step, 1.0), - ("", 0.0), -}; - -funw := array[] of -{ - ("log", Olog, 1), - ("ln", Olog, 1), - ("log10", Olog10, 1), - ("log2", Olog2, 1), - ("logb", Ologb, 2), - ("exp", Oexpf, 1), - ("pow", Opow, 2), - ("sqrt", Osqrt, 1), - ("cbrt", Ocbrt, 1), - ("floor", Ofloor, 1), - ("ceiling", Oceil, 1), - ("min", Omin, 2), - ("max", Omax, 2), - ("abs", Oabs, 1), - ("Γ", Ogamma, 1), - ("gamma", Ogamma, 1), - ("sign", Osign, 1), - ("int", Oint, 1), - ("frac", Ofrac, 1), - ("round", Oround, 1), - ("erf", Oerf, 1), - ("atan2", Oatan2, 2), - ("sin", Osin, 1), - ("cos", Ocos, 1), - ("tan", Otan, 1), - ("asin", Oasin, 1), - ("acos", Oacos, 1), - ("atan", Oatan, 1), - ("sinh", Osinh, 1), - ("cosh", Ocosh, 1), - ("tanh", Otanh, 1), - ("asinh", Oasinh, 1), - ("acosh", Oacosh, 1), - ("atanh", Oatanh, 1), - ("rand", Orand, 0), - ("Σ", Osigma, 3), - ("sigma", Osigma, 3), - ("Π", Opi, 3), - ("pi", Opi, 3), - ("cfrac", Ocfrac, 3), - ("Δ", Oderiv, 2), - ("differential", Oderiv, 2), - ("∫", Ointeg, 3), - ("integral", Ointeg, 3), - ("solve", Osolve, 1), - ("", 0, 0), -}; - -stdin: int; -bin: ref Iobuf; -lineno: int = 1; -file: string; -iostack: list of (int, int, int, string, ref Iobuf); -geof: int; -garg: string; -gargs: list of string; -bufc: int = None; -buft: int = Olast; -lexes: int; -lexval: real; -lexstr: string; -lexsym: ref Sym; -syms: array of ref Sym; -deg: ref Dec; -pbase: ref Dec; -errdec: ref Dec; -inloop: int; -infn: int; - -Node: adt -{ - op: int; - left: cyclic ref Node; - right: cyclic ref Node; - val: real; - str: string; - dec: cyclic ref Dec; - src: int; -}; - -Dec: adt -{ - kind: int; - scope: int; - sym: cyclic ref Sym; - val: real; - na: int; - code: cyclic ref Node; - old: cyclic ref Dec; - next: cyclic ref Dec; -}; - -Sym: adt -{ - name: string; - kind: int; - dec: cyclic ref Dec; - next: cyclic ref Sym; -}; - -opstring(t: int): string -{ - s := opss[t]; - if(s != nil) - return s; - for(i := 0; keyw[i].t0 != nil; i++) - if(t == keyw[i].t1) - return keyw[i].t0; - for(i = 0; funw[i].t0 != nil; i++) - if(t == funw[i].t1) - return funw[i].t0; - return s; -} - -err(s: string) -{ - sys->print("error: %s\n", s); -} - -error(n: ref Node, s: string) -{ - if(n != nil) - lno := n.src; - else - lno = lineno; - s = sys->sprint("line %d: %s", lno, s); - if(file != nil) - s = sys->sprint("file %s: %s", file, s); - raise s; -} - -fatal(s: string) -{ - sys->print("fatal: %s\n", s); - exit; -} - -stack(s: string, f: ref Iobuf) -{ - iostack = (bufc, buft, lineno, file, bin) :: iostack; - bufc = None; - buft = Olast; - lineno = 1; - file = s; - bin = f; -} - -unstack() -{ - (bufc, buft, lineno, file, bin) = hd iostack; - iostack = tl iostack; -} - -doinclude(s: string) -{ - f := bufio->open(s, Sys->OREAD); - if(f == nil) - error(nil, sys->sprint("cannot open %s", s)); - stack(s, f); -} - -getc(): int -{ - if((c := bufc) != None) - bufc = None; - else if(bin != nil) - c = bin.getc(); - else{ - if(garg == nil){ - if(gargs == nil){ - if(geof == 0){ - geof = 1; - c = '\n'; - } - else - c = Eof; - } - else{ - garg = hd gargs; - gargs = tl gargs; - c = ' '; - } - } - else{ - c = garg[0]; - garg = garg[1: ]; - } - } - if(c == Eof && iostack != nil){ - unstack(); - return getc(); - } - return c; -} - -ungetc(c: int) -{ - bufc = c; -} - -slash(c: int): int -{ - if(c != '\\') - return c; - nc := getc(); - case(nc){ - 'b' => return '\b'; - 'f' => return '\f'; - 'n' => return '\n'; - 'r' => return '\r'; - 't' => return '\t'; - } - return nc; -} - -lexstring(): int -{ - sp := ""; - while((c := getc()) != '"'){ - if(c == Eof) - raise Eeof; - sp[len sp] = slash(c); - } - lexstr = sp; - return Ostring; -} - -lexchar(): int -{ - while((c := getc()) != '\''){ - if(c == Eof) - raise Eeof; - lexval = real slash(c); - } - return Onum; -} - -basev(c: int, base: int): int -{ - if(c >= 'a' && c <= 'z') - c += 10-'a'; - else if(c >= 'A' && c <= 'Z') - c += 10-'A'; - else if(c >= '0' && c <= '9') - c -= '0'; - else - return -1; - if(c >= base) - error(nil, "bad digit"); - return c; -} - -lexe(base: int): int -{ - neg := 0; - v := big 0; - c := getc(); - if(c == '-') - neg = 1; - else - ungetc(c); - for(;;){ - c = getc(); - cc := basev(c, base); - if(cc < 0){ - ungetc(c); - break; - } - v = big base*v+big cc; - } - if(neg) - v = -v; - return int v; -} - -lexnum(): int -{ - base := 10; - exp := 0; - r := f := e := 0; - v := big 0; - c := getc(); - if(c == '0'){ - base = 8; - c = getc(); - if(c == '.'){ - base = 10; - ungetc(c); - } - else if(c == 'x' || c == 'X') - base = 16; - else - ungetc(c); - } - else - ungetc(c); - for(;;){ - c = getc(); - if(!r && (c == 'r' || c == 'R')){ - if(f || e) - error(nil, "bad base"); - r = 1; - base = int v; - if(base < 2 || base > 36) - error(nil, "bad base"); - v = big 0; + if((bufio = load Bufio Bufio->PATH) == nil) + fatal("can't load " + Bufio->PATH); + if((env = load Env Env->PATH) == nil) + fatal("can't load " + Env->PATH); + if((draw = load Draw Draw->PATH) == nil) + fatal("can't load " + Draw->PATH); + if((arg := load Arg Arg->PATH) == nil) + fatal("can't load " + Arg->PATH); + + getwidth(ctxt); + arg->init(argv); + arg->setusage("mc [-c columns] [file ...]"); + while((c:=arg->opt()) != 0) + case c { + 'c' => columns = int arg->earg() * mintab; + * => arg->usage(); + } + argv = arg->argv(); + if(len argv == 0) + argv = "/fd/0" :: nil; + + a := array[1024] of (string, int); + n := 0; + maxwidth := 0; + for(; argv!=nil; argv=tl argv){ + if((bin:=bufio->open(hd argv, OREAD)) == nil){ + fprint(fildes(2), "mc: can't open %s: %r\n", hd argv); continue; } - if(c == '.'){ - if(f || e) - error(nil, "bad real"); - f = 1; - continue; - } - if(base == 10 && (c == 'e' || c == 'E')){ - if(e) - error(nil, "bad E part"); - e = 1; - exp = lexe(base); - continue; - } - cc := basev(c, base); - if(cc < 0){ - ungetc(c); - break; - } - v = big base*v+big cc; - if(f) - f++; - } - lexval = real v; - if(f) - lexval /= real base**(f-1); - if(exp){ - if(exp > 0) - lexval *= real base**exp; - else - lexval *= maths->pow(real base, real exp); - } - return Onum; -} - -lexid(): int -{ - sp := ""; - for(;;){ - c := getc(); - if(c >= 'a' && c <= 'z' || c >= 'A' && c <= 'Z' || c >= '0' && c <= '9' || c >= 'α' && c <= 'ω' || c >= 'Α' && c <= 'Ω' || c == '_') - sp[len sp] = c; - else{ - ungetc(c); - break; - } - } - lexsym = enter(sp, Oident); - return lexsym.kind; -} - -follow(c: int, c1: int, c2: int): int -{ - nc := getc(); - if(nc == c) - return c1; - ungetc(nc); - return c2; -} - -skip() -{ - if((t := buft) != Olast){ - lex(); - if(t == Onl) - return; - } - for(;;){ - c := getc(); - if(c == Eof){ - ungetc(c); - return; - } - if(c == '\n'){ - lineno++; - return; - } - } -} - -lex(): int -{ - lexes++; - if((t := buft) != Olast){ - buft = Olast; - if(t == Onl) - lineno++; - return t; - } - for(;;){ - case(c := getc()){ - Eof => - return Oeof; - '#' => - while((c = getc()) != '\n'){ - if(c == Eof) - raise Eeof; + while((s:=bin.gets('\n')) != nil){ + if(s[len s-1] == '\n') + s = s[0:len s-1]; + if(n == len a) + a = (array[n+1024] of (string, int))[0:] = a; + a[n].t0 = s; + a[n].t1 = wordsize(s); + if(a[n].t1 > maxwidth) + maxwidth = a[n].t1; + n++; + } + bin.close(); + } + outcols(a[:n], maxwidth); +} + +outcols(words: array of (string, int), maxwidth: int) +{ + maxwidth = nexttab(maxwidth+mintab-1); + numcols := columns / maxwidth; + if(numcols <= 0) + numcols = 1; + nwords := len words; + nlines := (nwords+numcols-1) / numcols; + bout := bufio->fopen(fildes(1), OWRITE); + for(i := 0; i < nlines; i++){ + col := endcol := 0; + for(j:=i; j<nwords; j+=nlines){ + endcol += maxwidth; + bout.puts(words[j].t0); + col += words[j].t1; + if(j+nlines < nwords){ + while(col < endcol){ + if(tabwid) + bout.putc('\t'); + else + bout.putc(' '); + col = nexttab(col); + } } - lineno++; - '\n' => - lineno++; - return Onl; - ' ' or - '\t' or - '\r' or - '\v' => - ; - '"' => - return lexstring(); - '\'' => - return lexchar(); - '0' to '9' => - ungetc(c); - return lexnum(); - 'a' to 'z' or - 'A' to 'Z' or - 'α' to 'ω' or - 'Α' to 'Ω' or - '_' => - ungetc(c); - return lexid(); - '+' => - c = getc(); - if(c == '=') - return Oadde; - ungetc(c); - return follow('+', Oinc, Oadd); - '-' => - c = getc(); - if(c == '=') - return Osube; - if(c == '>') - return Oimp; - ungetc(c); - return follow('-', Odec, Osub); - '*' => - c = getc(); - if(c == '=') - return Omule; - if(c == '*') - return follow('=', Oexpe, Oexp); - ungetc(c); - return Omul; - '/' => - c = getc(); - if(c == '=') - return Odive; - if(c == '/') - return follow('=', Oidive, Oidiv); - ungetc(c); - return Odiv; - '%' => - return follow('=', Omode, Omod); - '&' => - c = getc(); - if(c == '=') - return Oande; - ungetc(c); - return follow('&', Oandand, Oand); - '|' => - c = getc(); - if(c == '=') - return Oore; - ungetc(c); - return follow('|', Ooror, Oor); - '^' => - return follow('=', Oxore, Oxor); - '=' => - return follow('=', Oeq, Oas); - '!' => - return follow('=', One, Oexc); - '>' => - c = getc(); - if(c == '=') - return Oge; - if(c == '>') - return follow('=', Orshe, Orsh); - ungetc(c); - return Ogt; - '<' => - c = getc(); - if(c == '=') - return Ole; - if(c == '<') - return follow('=', Olshe, Olsh); - if(c == '-') - return follow('>', Oiff, Oimpby); - ungetc(c); - return Olt; - '(' => - return Olbr; - ')' => - return Orbr; - '{' => - return Olcbr; - '}' => - return Orcbr; - '~' => - return Ocom; - '.' => - ungetc(c); - return lexnum(); - ',' => - return Ocomma; - '?' => - return Oquest; - ':' => - return follow('=', Odas, Ocolon); - ';' => - return Oscolon; - '↑' => - return Onand; - '↓' => - return Onor; - '∞' => - lexval = Infinity; - return Onum; - * => - error(nil, sys->sprint("bad character %c", c)); } + bout.putc('\n'); } + bout.close(); } -unlex(t: int) -{ - lexes--; - buft = t; - if(t == Onl) - lineno--; -} - -mustbe(t: int) -{ - nt := lex(); - if(nt != t) - error(nil, sys->sprint("expected %s not %s", opstring(t), opstring(nt))); -} - -consume(t: int) -{ - nt := lex(); - if(nt != t) - unlex(nt); -} - -elex(): int -{ - t := lex(); - if(binary(t)) - return t; - if(hexp(t)){ - unlex(t); - return Oscomma; - } - return t; -} - -hexp(o: int): int -{ - return preunary(o) || o == Olbr || atom(o); -} - -atom(o: int): int -{ - return o >= Ostring && o <= Olfun; -} - -asop(o: int): int -{ - return o == Oas || o == Odas || o >= Oadde && o <= Orshe || o >= Oinc && o <= Opostdec; -} - -preunary(o: int): int -{ - return ops[o]&Preunary; -} - -postunary(o: int): int -{ - return ops[o]&Postunary; -} - -binary(o: int): int -{ - return ops[o]&Binary; -} - -prec(o: int): int -{ - return ops[o]&Prec; -} - -assoc(o: int): int -{ - return ops[o]&Assoc; -} - -rassoc(o: int): int -{ - return ops[o]&Rassoc; -} - -preop(o: int): int -{ - case(o){ - Oadd => return Oplus; - Osub => return Ominus; - Oinc => return Opreinc; - Odec => return Opredec; - Oexc => return Onot; - } - return o; -} - -postop(o: int): int -{ - case(o){ - Oinc => return Opostinc; - Odec => return Opostdec; - Oexc => return Ofact; - } - return o; -} - -prtree(p: ref Node, in: int) -{ - if(p == nil) - return; - for(i := 0; i < in; i++) - sys->print(" "); - sys->print("%s ", opstring(p.op)); - case(p.op){ - Ostring => - sys->print("%s", p.str); - Onum => - sys->print("%g", p.val); - Ocon or - Ovar => - sys->print("%s(%g)", p.dec.sym.name, p.dec.val); - Ofun or - Olfun => - sys->print("%s", p.dec.sym.name); - } - sys->print("\n"); - # sys->print(" - %d\n", p.src); - prtree(p.left, in+1); - prtree(p.right, in+1); -} - -tree(o: int, l: ref Node, r: ref Node): ref Node -{ - p := ref Node; - p.op = o; - p.left = l; - p.right = r; - p.src = lineno; - if(asop(o)){ - if(o >= Oadde && o <= Orshe){ - p = tree(Oas, l, p); - p.right.op += Oadd-Oadde; - } - } - return p; -} - -itree(n: int): ref Node -{ - return vtree(real n); -} - -vtree(v: real): ref Node -{ - n := tree(Onum, nil, nil); - n.val = v; - return n; -} - -ltree(s: string, a: ref Node): ref Node -{ - n := tree(Olfun, a, nil); - n.dec = lookup(s).dec; - return n; -} - -ptree(n: ref Node, p: real): ref Node -{ - if(isinteger(p)){ - i := int p; - if(i == 0) - return itree(1); - if(i == 1) - return n; - if(i == -1) - return tree(Oinv, n, nil); - if(i < 0) - return tree(Oinv, tree(Oexp, n, itree(-i)), nil); - } - return tree(Oexp, n, vtree(p)); -} - -iscon(n: ref Node): int -{ - return n.op == Onum || n.op == Ocon; -} - -iszero(n: ref Node): int -{ - return iscon(n) && eval(n) == 0.0; -} - -isone(n: ref Node): int -{ - return iscon(n) && eval(n) == 1.0; -} - -isnan(n: ref Node): int -{ - return iscon(n) && maths->isnan(eval(n)); -} - -isinf(n: ref Node): int -{ - return iscon(n) && (v := eval(n)) == Infinity || v == -Infinity; -} - -stat(scope: int): ref Node -{ - e1, e2, e3, e4: ref Node; - - consume(Onl); - t := lex(); - case(t){ - Olcbr => - if(scope) - pushscope(); - for(;;){ - e2 = stat(1); - if(e1 == nil) - e1 = e2; - else - e1 = tree(Ocomma, e1, e2); - consume(Onl); - t = lex(); - if(t == Oeof) - raise Eeof; - if(t == Orcbr) - break; - unlex(t); - } - if(scope) - popscope(); - return e1; - Oprint or - Oread or - Oret => - if(t == Oret && !infn) - error(nil, "return not in fn"); - e1= tree(t, expr(0, 1), nil); - consume(Oscolon); - if(t == Oread) - allvar(e1.left); - return e1; - Oif => - # mustbe(Olbr); - e1 = expr(0, 1); - # mustbe(Orbr); - e2 = stat(1); - e3 = nil; - consume(Onl); - t = lex(); - if(t == Oelse) - e3 = stat(1); - else - unlex(t); - return tree(Oif, e1, tree(Ocomma, e2, e3)); - Ofor => - inloop++; - mustbe(Olbr); - e1 = expr(0, 1); - mustbe(Oscolon); - e2 = expr(0, 1); - mustbe(Oscolon); - e3 = expr(0, 1); - mustbe(Orbr); - e4 = stat(1); - inloop--; - return tree(Ocomma, e1, tree(Ofor, e2, tree(Ocomma, e4, e3))); - Owhile => - inloop++; - # mustbe(Olbr); - e1 = expr(0, 1); - # mustbe(Orbr); - e2 = stat(1); - inloop--; - return tree(Ofor, e1, tree(Ocomma, e2, nil)); - Odo => - inloop++; - e1 = stat(1); - consume(Onl); - mustbe(Owhile); - # mustbe(Olbr); - e2 = expr(0, 1); - # mustbe(Orbr); - consume(Oscolon); - inloop--; - return tree(Odo, e1, e2); - Obreak or - Ocont or - Oexit => - if((t == Obreak || t == Ocont) && !inloop) - error(nil, "break/continue not in loop"); - consume(Oscolon); - return tree(t, nil, nil); - Ofn => - if(infn) - error(nil, "nested functions not allowed"); - infn++; - mustbe(Oident); - s := lexsym; - d := mkdec(s, Ofun, 1); - d.code = tree(Ofn, nil, nil); - pushscope(); - (d.na, d.code.left) = args(0); - allvar(d.code.left); - pushparams(d.code.left); - d.code.right = stat(0); - popscope(); - infn--; - return d.code; - Oinclude => - e1 = expr(0, 0); - if(e1.op != Ostring) - error(nil, "bad include file"); - consume(Oscolon); - doinclude(e1.str); - return nil; - * => - unlex(t); - e1 = expr(0, 1); - consume(Oscolon); - if(debug) - prnode(e1); - return e1; - } - return nil; -} - -ckstat(n: ref Node, parop: int, pr: int) -{ - if(n == nil) - return; - pr |= n.op == Oprint; - ckstat(n.left, n.op, pr); - ckstat(n.right, n.op, pr); - case(n.op){ - Ostring => - if(!pr || parop != Oprint && parop != Ocomma) - error(n, "illegal string operation"); - } -} - -pexp(e: ref Node): int -{ - if(e == nil) - return 0; - if(e.op == Ocomma) - return pexp(e.right); - return e.op >= Ostring && e.op <= Oiff && !asop(e.op); -} - -expr(p: int, zok: int): ref Node +wordsize(s: string): int { - n := exp(p, zok); - ckexp(n, Onothing); - return n; + if(font != nil) + return font.width(s); + return len s; } -exp(p: int, zok: int): ref Node +nexttab(col: int): int { - l := prim(zok); - if(l == nil) - return nil; - while(binary(t := elex()) && (o := prec(t)) >= p){ - if(rassoc(t)) - r := exp(o, 0); - else - r = exp(o+1, 0); - if(t == Oscomma) - t = Ocomma; - l = tree(t, l, r); - } - if(t != Oscomma) - unlex(t); - return l; -} - -prim(zok: int): ref Node -{ - p: ref Node; - na: int; - - t := lex(); - if(preunary(t)){ - t = preop(t); - return tree(t, exp(prec(t), 0), nil); - } - case(t){ - Olbr => - p = exp(0, zok); - mustbe(Orbr); - Ostring => - p = tree(t, nil, nil); - p.str = lexstr; - Onum => - p = tree(t, nil ,nil); - p.val = lexval; - Oident => - s := lexsym; - d := s.dec; - if(d == nil) - d = mkdec(s, Ovar, 0); - case(t = d.kind){ - Ocon or - Ovar => - p = tree(t, nil, nil); - p.dec = d; - Ofun or - Olfun => - p = tree(t, nil, nil); - p.dec = d; - (na, p.left) = args(prec(t)); - if(!(t == Olfun && d.val == real Osolve && na == 2)) - if(na != d.na) - error(p, "wrong number of arguments"); - if(t == Olfun){ - case(int d.val){ - Osigma or - Opi or - Ocfrac or - Ointeg => - if((op := p.left.left.left.op) != Oas && op != Odas) - error(p.left, "expression not an assignment"); - Oderiv => - if((op := p.left.left.op) != Oas && op != Odas) - error(p.left, "expression not an assignment"); - } - } - } - * => - unlex(t); - if(!zok) - error(nil, "missing expression"); - return nil; + if(tabwid){ + col += tabwid; + col -= col%tabwid; + return col; } - while(postunary(t = lex())){ - t = postop(t); - p = tree(t, p, nil); - } - unlex(t); - return p; + return col+1; } -ckexp(n: ref Node, parop: int) +getwidth(ctxt: ref Draw->Context) { - if(n == nil) + if((wid:=env->getenv("acmewin")) == nil) return; - o := n.op; - l := n.left; - r := n.right; - if(asop(o)) - var(l); - case(o){ - Ovar => - s := n.dec.sym; - d := s.dec; - if(d == nil){ - if(strict) - error(n, sys->sprint("%s undefined", s.name)); - d = mkdec(s, Ovar, 1); - } - n.dec = d; - Odas => - ckexp(r, o); - l.dec = mkdec(l.dec.sym, Ovar, 1); - * => - ckexp(l, o); - ckexp(r, o); - if(o == Oquest && r.op != Ocolon) - error(n, "bad '?' operator"); - if(o == Ocolon && parop != Oquest) - error(n, "bad ':' operator"); - } -} - -commas(n: ref Node): int -{ - if(n == nil || n.op == Ofun || n.op == Olfun) - return 0; - c := commas(n.left)+commas(n.right); - if(n.op == Ocomma) - c++; - return c; -} - -allvar(n: ref Node) -{ - if(n == nil) + if((fd:=open("/chan/" + wid + "/ctl", ORDWR)) == nil) return; - if(n.op == Ocomma){ - allvar(n.left); - allvar(n.right); + buf := array[256] of byte; + if((n:=read(fd, buf, len buf)) <= 0) return; - } - var(n); -} - -args(p: int): (int, ref Node) -{ - if(!p) - mustbe(Olbr); - a := exp(p, 1); - if(!p) - mustbe(Orbr); - na := 0; - if(a != nil) - na = commas(a)+1; - return (na, a); -} - -hash(s: string): int -{ - l := len s; - h := 4104; - for(i := 0; i < l; i++) - h = 1729*h ^ s[i]; - if(h < 0) - h = -h; - return h&(Hash-1); -} - -enter(sp: string, k: int): ref Sym -{ - for(s := syms[hash(sp)]; s != nil; s = s.next){ - if(sp == s.name) - return s; - } - s = ref Sym; - s.name = sp; - s.kind = k; - h := hash(sp); - s.next = syms[h]; - syms[h] = s; - return s; -} - -lookup(sp: string): ref Sym -{ - return enter(sp, Oident); -} - -mkdec(s: ref Sym, k: int, dec: int): ref Dec -{ - d := ref Dec; - d.kind = k; - d.val = 0.0; - d.na = 0; - d.sym = s; - d.scope = 0; - if(dec) - pushdec(d); - return d; -} - -adddec(sp: string, k: int, v: real, n: int): ref Dec -{ - d := mkdec(enter(sp, Oident), k, 1); - d.val = v; - d.na = n; - return d; -} - -scope: int; -curscope: ref Dec; -scopes: list of ref Dec; - -pushscope() -{ - scope++; - scopes = curscope :: scopes; - curscope = nil; -} - -popscope() -{ - popdecs(); - curscope = hd scopes; - scopes = tl scopes; - scope--; -} - -pushparams(n: ref Node) -{ - if(n == nil) + (nf, f) := tokenize(string buf[:n], " "); + if(nf != 8) return; - if(n.op == Ocomma){ - pushparams(n.left); - pushparams(n.right); + f0 := tl tl tl tl tl f; + if((font=Font.open(ctxt.display, hd tl f0)) == nil) return; - } - n.dec = mkdec(n.dec.sym, Ovar, 1); -} - -pushdec(d: ref Dec) -{ - if(0 && debug) - sys->print("dec %s scope %d\n", d.sym.name, scope); - d.scope = scope; - s := d.sym; - if(s.dec != nil && s.dec.scope == scope) - error(nil, sys->sprint("redeclaration of %s", s.name)); - d.old = s.dec; - s.dec = d; - d.next = curscope; - curscope = d; -} - -popdecs() -{ - nd: ref Dec; - for(d := curscope; d != nil; d = nd){ - d.sym.dec = d.old; - d.old = nil; - nd = d.next; - d.next = nil; - } - curscope = nil; -} - -estat(n: ref Node): (int, real) -{ - k: int; - v: real; - - if(n == nil) - return (Onothing, 0.0); - l := n.left; - r := n.right; - case(n.op){ - Ocomma => - (k, v) = estat(l); - if(k == Oexit || k == Oret || k == Obreak || k == Ocont) - return (k, v); - return estat(r); - Oprint => - v = print(l); - return (Onothing, v); - Oread => - v = read(l); - return (Onothing, v); - Obreak or - Ocont or - Oexit => - return (n.op, 0.0); - Oret => - return (Oret, eval(l)); - Oif => - v = eval(l); - if(int v) - return estat(r.left); - else if(r.right != nil) - return estat(r.right); - else - return (Onothing, v); - Ofor => - for(;;){ - v = eval(l); - if(!int v) - break; - (k, v) = estat(r.left); - if(k == Oexit || k == Oret) - return (k, v); - if(k == Obreak) - break; - if(r.right != nil) - v = eval(r.right); - } - return (Onothing, v); - Odo => - for(;;){ - (k, v) = estat(l); - if(k == Oexit || k == Oret) - return (k, v); - if(k == Obreak) - break; - v = eval(r); - if(!int v) - break; - } - return (Onothing, v); - * => - return (Onothing, eval(n)); - } - return (Onothing, 0.0); -} - -eval(e: ref Node): real -{ - lv, rv: real; - - if(e == nil) - return 1.0; - o := e.op; - l := e.left; - r := e.right; - if(o != Ofun && o != Olfun) - lv = eval(l); - if(o != Oandand && o != Ooror && o != Oquest) - rv = eval(r); - case(o){ - Ostring => - return 0.0; - Onum => - return e.val; - Ocon or - Ovar => - return e.dec.val; - Ofun => - return call(e.dec, l); - Olfun => - return libfun(int e.dec.val, l); - Oadd => - return lv+rv; - Osub => - return lv-rv; - Omul => - return lv*rv; - Odiv => - return lv/rv; - Omod => - return real (big lv%big rv); - Oidiv => - return real (big lv/big rv); - Oand => - return real (big lv&big rv); - Oor => - return real (big lv|big rv); - Oxor => - return real (big lv^big rv); - Olsh => - return real (big lv<<int rv); - Orsh => - return real (big lv>>int rv); - Oeq => - return real (lv == rv); - One => - return real (lv != rv); - Ogt => - return real (lv > rv); - Olt => - return real (lv < rv); - Oge => - return real (lv >= rv); - Ole => - return real (lv <= rv); - Opreinc => - l.dec.val += 1.0; - return l.dec.val; - Opostinc => - l.dec.val += 1.0; - return l.dec.val-1.0; - Opredec => - l.dec.val -= 1.0; - return l.dec.val; - Opostdec => - l.dec.val -= 1.0; - return l.dec.val+1.0; - Oexp => - if(isinteger(rv) && rv >= 0.0) - return lv**int rv; - return maths->pow(lv, rv); - Oandand => - if(!int lv) - return lv; - return eval(r); - Ooror => - if(int lv) - return lv; - return eval(r); - Onot => - return real !int lv; - Ofact => - if(isinteger(lv) && lv >= 0.0){ - n := int lv; - lv = 1.0; - for(i := 2; i <= n; i++) - lv *= real i; - return lv; - } - return gamma(lv+1.0); - Ocom => - return real ~big lv; - Oas or - Odas => - l.dec.val = rv; - return rv; - Oplus => - return lv; - Ominus => - return -lv; - Oinv => - return 1.0/lv; - Ocomma => - return rv; - Oquest => - if(int lv) - return eval(r.left); - else - return eval(r.right); - Onand => - return real !(int lv&int rv); - Onor => - return real !(int lv|int rv); - Oimp => - return real (!int lv|int rv); - Oimpby => - return real (int lv|!int rv); - Oiff => - return real !(int lv^int rv); - * => - fatal(sys->sprint("case %s in eval", opstring(o))); - } - return 0.0; -} - -var(e: ref Node) -{ - if(e == nil || e.op != Ovar || e.dec.kind != Ovar) - error(e, "expected a variable"); + tabwid = int hd tl tl f0; + mintab = font.width("0"); + columns = int hd f0; } -libfun(o: int, a: ref Node): real -{ - a1, a2: real; - - case(o){ - Osolve => - return solve(a); - Osigma or - Opi or - Ocfrac => - return series(o, a); - Oderiv => - return differential(a); - Ointeg => - return integral(a); - } - v := 0.0; - if(a != nil && a.op == Ocomma){ - a1 = eval(a.left); - a2 = eval(a.right); - } - else - a1 = eval(a); - case(o){ - Olog => - v = maths->log(a1); - Olog10 => - v = maths->log10(a1); - Olog2 => - v = maths->log(a1)/maths->log(2.0); - Ologb => - v = maths->log(a1)/maths->log(a2); - Oexpf => - v = maths->exp(a1); - Opow => - v = maths->pow(a1, a2); - Osqrt => - v = maths->sqrt(a1); - Ocbrt => - v = maths->cbrt(a1); - Ofloor => - v = maths->floor(a1); - Oceil => - v = maths->ceil(a1); - Omin => - v = maths->fmin(a1, a2); - Omax => - v = maths->fmax(a1, a2); - Oabs => - v = maths->fabs(a1); - Ogamma => - v = gamma(a1); - Osign => - if(a1 > 0.0) - v = 1.0; - else if(a1 < 0.0) - v = -1.0; - else - v = 0.0; - Oint => - (vi, nil) := maths->modf(a1); - v = real vi; - Ofrac => - (nil, v) = maths->modf(a1); - Oround => - v = maths->rint(a1); - Oerf => - v = maths->erf(a1); - Osin => - v = maths->sin(D2R(a1)); - Ocos => - v = maths->cos(D2R(a1)); - Otan => - v = maths->tan(D2R(a1)); - Oasin => - v = R2D(maths->asin(a1)); - Oacos => - v = R2D(maths->acos(a1)); - Oatan => - v = R2D(maths->atan(a1)); - Oatan2 => - v = R2D(maths->atan2(a1, a2)); - Osinh => - v = maths->sinh(a1); - Ocosh => - v = maths->cosh(a1); - Otanh => - v = maths->tanh(a1); - Oasinh => - v = maths->asinh(a1); - Oacosh => - v = maths->acosh(a1); - Oatanh => - v = maths->atanh(a1); - Orand => - v = real rand->rand(Big)/real Big; - * => - fatal(sys->sprint("case %s in libfun", opstring(o))); - } - return v; -} - -series(o: int, a: ref Node): real -{ - p0, p1, q0, q1: real; - - l := a.left; - r := a.right; - if(o == Osigma) - v := 0.0; - else if(o == Opi) - v = 1.0; - else{ - p0 = q1 = 0.0; - p1 = q0 = 1.0; - v = Infinity; - } - i := l.left.left.dec; - ov := i.val; - i.val = eval(l.left.right); - eq := 0; - for(;;){ - rv := eval(l.right); - if(i.val > rv) - break; - lv := v; - ev := eval(r); - if(o == Osigma) - v += ev; - else if(o == Opi) - v *= ev; - else{ - t := ev*p1+p0; - p0 = p1; - p1 = t; - t = ev*q1+q0; - q0 = q1; - q1 = t; - v = p1/q1; - } - if(v == lv && rv == Infinity){ - eq++; - if(eq > 100) - break; - } - else - eq = 0; - i.val += 1.0; - } - i.val = ov; - return v; -} - -pushe(a: ref Node, l: list of real): list of real -{ - if(a == nil) - return l; - if(a.op == Ocomma){ - l = pushe(a.left, l); - return pushe(a.right, l); - } - l = eval(a) :: l; - return l; -} - -pusha(f: ref Node, l: list of real, nl: list of real): (list of real, list of real) -{ - if(f == nil) - return (l, nl); - if(f.op == Ocomma){ - (l, nl) = pusha(f.left, l, nl); - return pusha(f.right, l, nl); - } - l = f.dec.val :: l; - f.dec.val = hd nl; - return (l, tl nl); -} - -pop(f: ref Node, l: list of real): list of real -{ - if(f == nil) - return l; - if(f.op == Ocomma){ - l = pop(f.left, l); - return pop(f.right, l); - } - f.dec.val = hd l; - return tl l; -} - -rev(l: list of real): list of real -{ - nl: list of real; - - for( ; l != nil; l = tl l) - nl = hd l :: nl; - return nl; -} - -call(d: ref Dec, a: ref Node): real -{ - l: list of real; - - nl := rev(pushe(a, nil)); - (l, nil) = pusha(d.code.left, nil, nl); - l = rev(l); - (k, v) := estat(d.code.right); - l = pop(d.code.left, l); - if(k == Oexit) - exit; - return v; -} - -print(n: ref Node): real -{ - if(n == nil) - return 0.0; - if(n.op == Ocomma){ - print(n.left); - return print(n.right); - } - if(n.op == Ostring){ - sys->print("%s", n.str); - return 0.0; - } - v := eval(n); - printnum(v, ""); - return v; -} - -read(n: ref Node): real -{ - bio: ref Iobuf; - - if(n == nil) - return 0.0; - if(n.op == Ocomma){ - read(n.left); - return read(n.right); - } - sys->print("%s ? ", n.dec.sym.name); - if(!stdin){ - bio = bufio->fopen(sys->fildes(0), Sys->OREAD); - stack(nil, bio); - } - lexnum(); - consume(Onl); - n.dec.val = lexval; - if(!stdin && bin == bio) - unstack(); - return n.dec.val; -} - -isint(v: real): int -{ - return v >= -real Maxint && v <= real Maxint; -} - -isinteger(v: real): int -{ - return v == real int v && isint(v); -} - -split(v: real): (int, real) -{ - # v >= 0.0 - n := int v; - if(real n > v) - n--; - return (n, v-real n); -} - -n2c(n: int): int -{ - if(n < 10) - return n+'0'; - return n-10+'a'; -} - -gamma(v: real): real -{ - (s, lg) := maths->lgamma(v); - return real s*maths->exp(lg); -} - -D2R(a: real): real -{ - if(deg.val != 0.0) - a *= Pi/180.0; - return a; -} - -R2D(a: real): real -{ - if(deg.val != 0.0) - a /= Pi/180.0; - return a; -} - -side(n: ref Node): int -{ - if(n == nil) - return 0; - if(asop(n.op) || n.op == Ofun) - return 1; - return side(n.left) || side(n.right); -} - -sametree(n1: ref Node, n2: ref Node): int -{ - if(n1 == n2) - return 1; - if(n1 == nil || n2 == nil) - return 0; - if(n1.op != n2.op) - return 0; - case(n1.op){ - Ostring => - return n1.str == n2.str; - Onum => - return n1.val == n2.val; - Ocon or - Ovar => - return n1.dec == n2.dec; - Ofun or - Olfun => - return n1.dec == n2.dec && sametree(n1.left, n2.left); - * => - return sametree(n1.left, n2.left) && sametree(n1.right, n2.right); - } - return 0; -} - -simplify(n: ref Node): ref Node -{ - if(n == nil) - return nil; - op := n.op; - l := n.left = simplify(n.left); - r := n.right = simplify(n.right); - if(l != nil && iscon(l) && (r == nil || iscon(r))){ - if(isnan(l)) - return l; - if(r != nil && isnan(r)) - return r; - return vtree(eval(n)); - } - case(op){ - Onum or - Ocon or - Ovar or - Olfun or - Ocomma => - return n; - Oplus => - return l; - Ominus => - if(l.op == Ominus) - return l.left; - Oinv => - if(l.op == Oinv) - return l.left; - Oadd => - if(iszero(l)) - return r; - if(iszero(r)) - return l; - if(sametree(l, r)) - return tree(Omul, itree(2), l); - Osub => - if(iszero(l)) - return simplify(tree(Ominus, r, nil)); - if(iszero(r)) - return l; - if(sametree(l, r)) - return itree(0); - Omul => - if(iszero(l)) - return l; - if(iszero(r)) - return r; - if(isone(l)) - return r; - if(isone(r)) - return l; - if(sametree(l, r)) - return tree(Oexp, l, itree(2)); - Odiv => - if(iszero(l)) - return l; - if(iszero(r)) - return vtree(Infinity); - if(isone(l)) - return ptree(r, -1.0); - if(isone(r)) - return l; - if(sametree(l, r)) - return itree(1); - Oexp => - if(iszero(l)) - return l; - if(iszero(r)) - return itree(1); - if(isone(l)) - return l; - if(isone(r)) - return l; - * => - fatal(sys->sprint("case %s in simplify", opstring(op))); - } - return n; -} - -deriv(n: ref Node, d: ref Dec): ref Node -{ - if(n == nil) - return nil; - op := n.op; - l := n.left; - r := n.right; - case(op){ - Onum or - Ocon => - n = itree(0); - Ovar => - if(d == n.dec) - n = itree(1); - else - n = itree(0); - Olfun => - case(int n.dec.val){ - Olog => - n = ptree(l, -1.0); - Olog10 => - n = ptree(tree(Omul, l, vtree(Ln10)), -1.0); - Olog2 => - n = ptree(tree(Omul, l, vtree(Ln2)), -1.0); - Oexpf => - n = n; - Opow => - return deriv(tree(Oexp, l.left, l.right), d); - Osqrt => - return deriv(tree(Oexp, l, vtree(0.5)), d); - Ocbrt => - return deriv(tree(Oexp, l, vtree(1.0/3.0)), d); - Osin => - n = ltree("cos", l); - Ocos => - n = tree(Ominus, ltree("sin", l), nil); - Otan => - n = ptree(ltree("cos", l), -2.0); - Oasin => - n = ptree(tree(Osub, itree(1), ptree(l, 2.0)), -0.5); - Oacos => - n = tree(Ominus, ptree(tree(Osub, itree(1), ptree(l, 2.0)), -0.5), nil); - Oatan => - n = ptree(tree(Oadd, itree(1), ptree(l, 2.0)), -1.0); - Osinh => - n = ltree("cosh", l); - Ocosh => - n = ltree("sinh", l); - Otanh => - n = ptree(ltree("cosh", l), -2.0); - Oasinh => - n = ptree(tree(Oadd, itree(1), ptree(l, 2.0)), -0.5); - Oacosh => - n = ptree(tree(Osub, ptree(l, 2.0), itree(1)), -0.5); - Oatanh => - n = ptree(tree(Osub, itree(1), ptree(l, 2.0)), -1.0); - * => - return vtree(Nan); - } - return tree(Omul, n, deriv(l, d)); - Oplus or - Ominus => - n = tree(op, deriv(l, d), nil); - Oinv => - n = tree(Omul, tree(Ominus, ptree(l, -2.0), nil), deriv(l, d)); - Oadd or - Osub or - Ocomma => - n = tree(op, deriv(l, d), deriv(r, d)); - Omul => - n = tree(Oadd, tree(Omul, deriv(l, d), r), tree(Omul, l, deriv(r, d))); - Odiv => - n = tree(Osub, tree(Omul, deriv(l, d), r), tree(Omul, l, deriv(r, d))); - n = tree(Odiv, n, ptree(r, 2.0)); - Oexp => - nn := tree(Oadd, tree(Omul, deriv(l, d), tree(Odiv, r, l)), tree(Omul, ltree("log", l), deriv(r, d))); - n = tree(Omul, n, nn); - * => - n = vtree(Nan); - } - return n; -} - -derivative(n: ref Node, d: ref Dec): ref Node -{ - n = simplify(deriv(n, d)); - if(isnan(n)) - error(n, "no derivative"); - if(debug) - prnode(n); - return n; -} - -newton(f: ref Node, e: ref Node, d: ref Dec, v1: real, v2: real): (int, real) -{ - v := (v1+v2)/2.0; - lv := 0.0; - its := 0; - for(;;){ - lv = v; - d.val = v; - v = eval(e); - # if(v < v1 || v > v2) - # return (0, 0.0); - if(maths->isnan(v)) - return (0, 0.0); - if(its > 100 || fabs(v-lv) < Eps) - break; - its++; - } - if(fabs(v-lv) > Bigeps || fabs(eval(f)) > Bigeps) - return (0, 0.0); - return (1, v); -} - -solve(n: ref Node): real -{ - d: ref Dec; - - if(n == nil) - return Nan; - if(n.op == Ocomma){ # solve(..., var) - var(n.right); - d = n.right.dec; - n = n.left; - if(!varmem(n, d)) - error(n, "variable not in equation"); - } - else{ - d = findvar(n, nil); - if(d == nil) - error(n, "variable missing"); - if(d == errdec) - error(n, "one variable only required"); - } - if(n.op == Oeq) - n.op = Osub; - dn := derivative(n, d); - var := tree(Ovar, nil, nil); - var.dec = d; - nr := tree(Osub, var, tree(Odiv, n, dn)); - ov := d.val; - lim := lookup(Limit).dec.val; - step := lookup(Step).dec.val; - rval := Infinity; - d.val = -lim-step; - v1 := 0.0; - v2 := eval(n); - for(v := -lim; v <= lim; v += step){ - d.val = v; - v1 = v2; - v2 = eval(n); - if(maths->isnan(v2)) # v == nan, v <= nan, v >= nan all give 1 - continue; - if(fabs(v2) < Eps){ - if(v >= -lim && v <= lim && v != rval){ - printnum(v, " "); - rval = v; - } - } - else if(v1*v2 <= 0.0){ - (f, rv) := newton(n, nr, var.dec, v-step, v); - if(f && rv >= -lim && rv <= lim && rv != rval){ - printnum(rv, " "); - rval = rv; - } - } - } - d.val = ov; - if(rval == Infinity) - error(n, "no roots found"); - else - sys->print("\n"); - return rval; -} - -differential(n: ref Node): real -{ - x := n.left.left.dec; - ov := x.val; - v := evalx(derivative(n.right, x), x, eval(n.left.right)); - x.val = ov; - return v; -} - -integral(n: ref Node): real -{ - l := n.left; - r := n.right; - x := l.left.left.dec; - ov := x.val; - a := eval(l.left.right); - b := eval(l.right); - h := b-a; - end := evalx(r, x, a) + evalx(r, x, b); - odd := even := 0.0; - oldarea := 0.0; - area := h*end/2.0; - for(i := 1; i < 1<<16; i <<= 1){ - even += odd; - odd = 0.0; - xv := a+h/2.0; - for(j := 0; j < i; j++){ - odd += evalx(r, x, xv); - xv += h; - } - h /= 2.0; - oldarea = area; - area = h*(end+4.0*odd+2.0*even)/3.0; - if(maths->isnan(area)) - error(n, "integral not found"); - if(fabs(area-oldarea) < Eps) - break; - } - if(fabs(area-oldarea) > Bigeps) - error(n, "integral not found"); - x.val = ov; - return area; -} - -evalx(n: ref Node, d: ref Dec, v: real): real -{ - d.val = v; - return eval(n); -} - -findvar(n: ref Node, d: ref Dec): ref Dec -{ - if(n == nil) - return d; - d = findvar(n.left, d); - d = findvar(n.right, d); - if(n.op == Ovar){ - if(d == nil) - d = n.dec; - if(n.dec != d) - d = errdec; - } - return d; -} - -varmem(n: ref Node, d: ref Dec): int -{ - if(n == nil) - return 0; - if(n.op == Ovar) - return d == n.dec; - return varmem(n.left, d) || varmem(n.right, d); -} - -fabs(r: real): real -{ - if(r < 0.0) - return -r; - return r; -} - -cvt(v: real, base: int): string -{ - if(base == 10) - return sys->sprint("%g", v); - neg := 0; - if(v < 0.0){ - neg = 1; - v = -v; - } - if(!isint(v)){ - n := 0; - lg := maths->log(v)/maths->log(real base); - if(lg < 0.0){ - (n, nil) = split(-lg); - v *= real base**n; - n = -n; - } - else{ - (n, nil) = split(lg); - v /= real base**n; - } - s := cvt(v, base) + "E" + string n; - if(neg) - s = "-" + s; - return s; - } - (n, f) := split(v); - s := ""; - do{ - r := n%base; - n /= base; - s[len s] = n2c(r); - }while(n != 0); - ls := len s; - for(i := 0; i < ls/2; i++){ - t := s[i]; - s[i] = s[ls-1-i]; - s[ls-1-i] = t; - } - if(f != 0.0){ - s[len s] = '.'; - for(i = 0; i < 16 && f != 0.0; i++){ - f *= real base; - (n, f) = split(f); - s[len s] = n2c(n); - } - } - s = string base + "r" + s; - if(neg) - s = "-" + s; - return s; -} - -printnum(v: real, s: string) -{ - base := int pbase.val; - if(!isinteger(pbase.val) || base < 2 || base > 36) - base = 10; - sys->print("%s%s", cvt(v, base), s); - if(bits){ - r := array[1] of real; - b := array[8] of byte; - r[0] = v; - maths->export_real(b, r); - for(i := 0; i < 8; i++) - sys->print("%2.2x ", int b[i]); - sys->print("\n"); - } -} - -Left, Right, Pre, Post: con 1<<iota; - -lspace := array[] of { 0, 0, 2, 3, 4, 5, 0, 0, 0, 9, 10, 0, 0, 0, 0, 0, 0, 0 }; -rspace := array[] of { 0, 1, 2, 3, 4, 5, 0, 0, 0, 9, 10, 0, 0, 0, 0, 0, 0, 0 }; - -preced(op1: int, op2: int, s: int): int -{ - br := 0; - p1 := prec(op1); - p2 := prec(op2); - if(p1 > p2) - br = 1; - else if(p1 == p2){ - if(op1 == op2){ - if(rassoc(op1)) - br = s == Left; - else - br = s == Right && !assoc(op1); - } - else{ - if(rassoc(op1)) - br = s == Left; - else - br = s == Right && op1 != Oadd; - if(postunary(op1) && preunary(op2)) - br = 1; - } - } - return br; -} - -prnode(n: ref Node) -{ - pnode(n, Onothing, Pre); - sys->print("\n"); -} - -pnode(n: ref Node, opp: int, s: int) +fatal(s: string) { - if(n == nil) - return; - op := n.op; - if(br := preced(opp, op, s)) - sys->print("("); - if(op == Oas && n.right.op >= Oadd && n.right.op <= Orsh && n.left == n.right.left){ - pnode(n.left, op, Left); - sys->print(" %s ", opstring(n.right.op+Oadde-Oadd)); - pnode(n.right.right, op, Right); - } - else if(binary(op)){ - p := prec(op); - pnode(n.left, op, Left); - if(lspace[p]) - sys->print(" "); - sys->print("%s", opstring(op)); - if(rspace[p]) - sys->print(" "); - pnode(n.right, op, Right); - } - else if(op == Oinv){ # cannot print postunary -1 - sys->print("%s", opstring(op)); - pnode(n.left, Odiv, Right); - } - else if(preunary(op)){ - sys->print("%s", opstring(op)); - pnode(n.left, op, Pre); - } - else if(postunary(op)){ - pnode(n.left, op, Post); - sys->print("%s", opstring(op)); - } - else{ - case(op){ - Ostring => - sys->print("%s", n.str); - Onum => - sys->print("%g", n.val); - Ocon or - Ovar => - sys->print("%s", n.dec.sym.name); - Ofun or - Olfun => - sys->print("%s(", n.dec.sym.name); - pnode(n.left, Onothing, Pre); - sys->print(")"); - * => - fatal(sys->sprint("bad op %s in pnode()", opstring(op))); - } - } - if(br) - sys->print(")"); + fprint(fildes(2), "mc: %s: %r\n", s); + raise "fail:"+s; } |