summaryrefslogtreecommitdiff
path: root/appl/cmd/mc.b
diff options
context:
space:
mode:
Diffstat (limited to 'appl/cmd/mc.b')
-rw-r--r--appl/cmd/mc.b2618
1 files changed, 108 insertions, 2510 deletions
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;
}
generated by cgit v1.2.3 (git 2.46.0) at 2025-12-10 14:30:04 +0000