Charles.Forsyth20070601-14568bd193319 years agoHistory
2547 lines · 40.9 KB · Brainfuck
RawDownload
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)

Lines 1–500 of 2547.