xref: /inferno-os/appl/cmd/limbo/nodes.b (revision 37da2899f40661e3e9631e497da8dc59b971cbd0)
1include "opname.m";
2
3znode:	Node;
4
5isused = array[Oend] of
6{
7	Oas =>		1,
8	Odas =>		1,
9	Oaddas =>	1,
10	Osubas =>	1,
11	Omulas =>	1,
12	Odivas =>	1,
13	Omodas =>	1,
14	Oexpas =>	1,
15	Oandas =>	1,
16	Ooras =>	1,
17	Oxoras =>	1,
18	Olshas =>	1,
19	Onothing =>	1,
20	Orshas =>	1,
21	Oinc =>		1,
22	Odec =>		1,
23	Opreinc =>	1,
24	Opredec =>	1,
25	Ocall =>	1,
26	Oraise =>	1,
27	Ospawn =>	1,
28	Osnd =>		1,
29	Orcv =>		1,
30
31	* =>		0
32};
33
34sideeffect := array[Oend] of
35{
36	Oas =>		1,
37	Odas =>		1,
38	Oaddas =>	1,
39	Osubas =>	1,
40	Omulas =>	1,
41	Odivas =>	1,
42	Omodas =>	1,
43	Oexpas =>	1,
44	Oandas =>	1,
45	Ooras =>	1,
46	Oxoras =>	1,
47	Olshas =>	1,
48	Orshas =>	1,
49	Oinc =>		1,
50	Odec =>		1,
51	Opreinc =>	1,
52	Opredec =>	1,
53	Ocall =>	1,
54	Oraise =>	1,
55	Ospawn =>	1,
56	Osnd =>		1,
57	Orcv =>		1,
58
59	Oadr =>		1,
60	Oarray =>	1,
61	Ocast =>	1,
62	Ochan =>	1,
63	Ocons =>	1,
64	Odiv =>		1,
65	Odot =>		1,
66	Oind =>		1,
67	Oindex =>	1,
68	Oinds =>	1,
69	Oindx =>	1,
70	Olen =>		1,
71	Oload =>	1,
72	Omod =>		1,
73	Oref =>		1,
74
75	* =>		0
76};
77
78opcommute = array[Oend] of
79{
80	Oeq =>		Oeq,
81	Oneq =>		Oneq,
82	Olt =>		Ogt,
83	Ogt =>		Olt,
84	Ogeq =>		Oleq,
85	Oleq =>		Ogeq,
86	Oadd =>		Oadd,
87	Omul =>		Omul,
88	Oxor =>		Oxor,
89	Oor =>		Oor,
90	Oand =>		Oand,
91
92	* =>		0
93};
94
95oprelinvert = array[Oend] of
96{
97
98	Oeq =>		Oneq,
99	Oneq =>		Oeq,
100	Olt =>		Ogeq,
101	Ogt =>		Oleq,
102	Ogeq =>		Olt,
103	Oleq =>		Ogt,
104
105	* =>		0
106};
107
108isrelop := array[Oend] of
109{
110
111	Oeq =>		1,
112	Oneq =>		1,
113	Olt =>		1,
114	Oleq =>		1,
115	Ogt =>		1,
116	Ogeq =>		1,
117	Oandand =>	1,
118	Ooror =>	1,
119	Onot =>		1,
120
121	* =>		0
122};
123
124ipow(x: big, n: int): big
125{
126	inv: int;
127	r: big;
128
129	inv = 0;
130	if(n < 0){
131		n = -n;
132		inv = 1;
133	}
134	r = big 1;
135	for(;;){
136		if(n&1)
137			r *= x;
138		if((n >>= 1) == 0)
139			break;
140		x *= x;
141	}
142	if(inv)
143		r = big 1/r;
144	return r;
145}
146
147rpow(x: real, n: int): real
148{
149	inv: int;
150	r: real;
151
152	inv = 0;
153	if(n < 0){
154		n = -n;
155		inv = 1;
156	}
157	r = 1.0;
158	for(;;){
159		if(n&1)
160			r *= x;
161		if((n >>= 1) == 0)
162			break;
163		x *= x;
164	}
165	if(inv)
166		r = 1.0/r;
167	return r;
168}
169
170real2fix(v: real, t: ref Type): big
171{
172	return big(v/scale(t));
173}
174
175fix2fix(v: big, f: ref Type, t: ref Type): big
176{
177	return big(real v * (scale(f)/scale(t)));
178}
179
180fix2real(v: big, f: ref Type): real
181{
182	return real v * scale(f);
183}
184
185istuple(n: ref Node): int
186{
187	d: ref Decl;
188
189	case(n.op){
190	Otuple =>
191		return 1;
192	Oname =>
193		d = n.decl;
194		if(d.importid != nil)
195			d = d.importid;
196		return d.store == Dconst && (n.ty.kind == Ttuple || n.ty.kind == Tadt);
197	Odot =>
198		return 0;	# istuple(n.left);
199	}
200	return 0;
201}
202
203tuplemem(n: ref Node, d: ref Decl): ref Node
204{
205	ty: ref Type;
206	ids: ref Decl;
207
208	ty = n.ty;
209	n = n.left;
210	for(ids = ty.ids; ids != nil; ids = ids.next){
211		if(ids.sym == d.sym)
212			break;
213		else
214			n = n.right;
215	}
216	if(n == nil)
217		fatal("tuplemem cannot cope !\n");
218	return n.left;
219}
220
221varcom(v: ref Decl): int
222{
223	n := v.init;
224	n = fold(n);
225	v.init = n;
226	if(debug['v'])
227		print("variable '%s' val %s\n", v.sym.name, expconv(n));
228	if(n == nil)
229		return 1;
230
231	tn := ref znode;
232	tn.op = Oname;
233	tn.decl = v;
234	tn.src = v.src;
235	tn.ty = v.ty;
236	return initable(tn, n, 0);
237}
238
239initable(v, n: ref Node, allocdep: int): int
240{
241	case n.ty.kind{
242	Tiface or
243	Tgoto or
244	Tcase or
245	Tcasel or
246	Tcasec or
247	Talt or
248	Texcept =>
249		return 1;
250	Tint or
251	Tbig or
252	Tbyte or
253	Treal or
254	Tstring or
255	Tfix =>
256		if(n.op != Oconst)
257			break;
258		return 1;
259	Tadt or
260	Tadtpick or
261	Ttuple =>
262		if(n.op == Otuple)
263			n = n.left;
264		else if(n.op == Ocall)
265			n = n.right;
266		else
267			break;
268		for(; n != nil; n = n.right)
269			if(!initable(v, n.left, allocdep))
270				return 0;
271		return 1;
272	Tarray =>
273		if(n.op != Oarray)
274			break;
275		if(allocdep >= DADEPTH){
276			nerror(v, expconv(v)+"s initializer has arrays nested more than "+string allocdep+" deep");
277			return 0;
278		}
279		allocdep++;
280		usedesc(mktdesc(n.ty.tof));
281		if(n.left.op != Oconst){
282			nerror(v, expconv(v)+"s size is not a constant");
283			return 0;
284		}
285		for(e := n.right; e != nil; e = e.right)
286			if(!initable(v, e.left.right, allocdep))
287				return 0;
288		return 1;
289	Tany =>
290		return 1;
291	Tref or
292	Tlist or
293	Tpoly or
294	* =>
295		nerror(v, "can't initialize "+etconv(v));
296		return 0;
297	}
298	nerror(v, expconv(v)+"s initializer, "+expconv(n)+", is not a constant expression");
299	return 0;
300}
301
302#
303# merge together two sorted lists, yielding a sorted list
304#
305elemmerge(e, f: ref Node): ref Node
306{
307	r := rock := ref Node;
308	while(e != nil && f != nil){
309		if(e.left.left.c.val <= f.left.left.c.val){
310			r.right = e;
311			e = e.right;
312		}else{
313			r.right = f;
314			f = f.right;
315		}
316		r = r.right;
317	}
318	if(e != nil)
319		r.right = e;
320	else
321		r.right = f;
322	return rock.right;
323}
324
325#
326# recursively split lists and remerge them after they are sorted
327#
328recelemsort(e: ref Node, n: int): ref Node
329{
330	if(n <= 1)
331		return e;
332	m := n / 2 - 1;
333	ee := e;
334	for(i := 0; i < m; i++)
335		ee = ee.right;
336	r := ee.right;
337	ee.right = nil;
338	return elemmerge(recelemsort(e, n / 2),
339			recelemsort(r, (n + 1) / 2));
340}
341
342#
343# sort the elems by index; wild card is first
344#
345elemsort(e: ref Node): ref Node
346{
347	n := 0;
348	for(ee := e; ee != nil; ee = ee.right){
349		if(ee.left.left.op == Owild)
350			ee.left.left.c = ref Const(big -1, 0.);
351		n++;
352	}
353	return recelemsort(e, n);
354}
355
356sametree(n1: ref Node, n2: ref Node): int
357{
358	if(n1 == n2)
359		return 1;
360	if(n1 == nil || n2 == nil)
361		return 0;
362	if(n1.op != n2.op || n1.ty != n2.ty)
363		return 0;
364	if(n1.op == Oconst){
365		case(n1.ty.kind){
366		Tbig or
367		Tbyte or
368		Tint =>
369			return n1.c.val == n2.c.val;
370		Treal =>
371			return n1.c.rval == n2.c.rval;
372		Tfix =>
373			return n1.c.val == n2.c.val && tequal(n1.ty, n2.ty);
374		Tstring =>
375			return n1.decl.sym == n2.decl.sym;
376		}
377		return 0;
378	}
379	return n1.decl == n2.decl && sametree(n1.left, n2.left) && sametree(n1.right, n2.right);
380}
381
382occurs(d: ref Decl, n: ref Node): int
383{
384	if(n == nil)
385		return 0;
386	if(n.op == Oname){
387		if(d == n.decl)
388			return 1;
389		return 0;
390	}
391	return occurs(d, n.left) + occurs(d, n.right);
392}
393
394#
395# left and right subtrees the same
396#
397folds(n: ref Node): ref Node
398{
399	if(hasside(n, 1))
400		return n;
401	case(n.op){
402	Oeq or
403	Oleq or
404	Ogeq =>
405		n.c = ref Const(big 1, 0.0);
406	Osub =>
407		n.c = ref Const(big 0, 0.0);
408	Oxor or
409	Oneq or
410	Olt or
411	Ogt =>
412		n.c = ref Const(big 0, 0.0);
413	Oand or
414	Oor or
415	Oandand or
416	Ooror =>
417		return n.left;
418	* =>
419		return n;
420	}
421	n.op = Oconst;
422	n.left = n.right = nil;
423	n.decl = nil;
424	return n;
425}
426
427#
428# constant folding for typechecked expressions
429#
430fold(n: ref Node): ref Node
431{
432	if(n == nil)
433		return nil;
434	if(debug['F'])
435		print("fold %s\n", nodeconv(n));
436	n = efold(n);
437	if(debug['F'])
438		print("folded %s\n", nodeconv(n));
439	return n;
440}
441
442efold(n: ref Node): ref Node
443{
444	d: ref Decl;
445
446	if(n == nil)
447		return nil;
448
449	left := n.left;
450	right := n.right;
451	case n.op{
452	Oname =>
453		d = n.decl;
454		if(d.importid != nil)
455			d = d.importid;
456		if(d.store != Dconst){
457			if(d.store == Dtag){
458				n.op = Oconst;
459				n.ty = tint;
460				n.c = ref Const(big d.tag, 0.);
461			}
462			break;
463		}
464		case n.ty.kind{
465		Tbig =>
466			n.op = Oconst;
467			n.c = ref Const(d.init.c.val, 0.);
468		Tbyte =>
469			n.op = Oconst;
470			n.c = ref Const(big byte d.init.c.val, 0.);
471		Tint or
472		Tfix =>
473			n.op = Oconst;
474			n.c = ref Const(big int d.init.c.val, 0.);
475		Treal =>
476			n.op = Oconst;
477			n.c = ref Const(big 0, d.init.c.rval);
478		Tstring =>
479			n.op = Oconst;
480			n.decl = d.init.decl;
481		Ttuple =>
482			*n = *d.init;
483		Tadt =>
484			*n = *d.init;
485			n = rewrite(n);	# was call
486		Texception =>
487			if(n.ty.cons == byte 0)
488				fatal("non-const exception type in efold");
489			n.op = Oconst;
490		* =>
491			fatal("unknown const type "+typeconv(n.ty)+" in efold");
492		}
493	Oadd =>
494		left = efold(left);
495		right = efold(right);
496		n.left = left;
497		n.right = right;
498		if(n.ty == tstring && right.op == Oconst){
499			if(left.op == Oconst)
500				n = mksconst(n.src, stringcat(left.decl.sym, right.decl.sym));
501			else if(left.op == Oadd && left.ty == tstring && left.right.op == Oconst){
502				left.right = mksconst(n.src, stringcat(left.right.decl.sym, right.decl.sym));
503				n = left;
504			}
505		}
506	Olen =>
507		left = efold(left);
508		n.left = left;
509		if(left.ty == tstring && left.op == Oconst)
510			n = mkconst(n.src, big len left.decl.sym.name);
511	Oslice =>
512		if(right.left.op == Onothing)
513			right.left = mkconst(right.left.src, big 0);
514		n.left = efold(left);
515		n.right = efold(right);
516	Oinds =>
517		n.left = left = efold(left);
518		n.right = right = efold(right);
519		if(right.op == Oconst && left.op == Oconst){
520			;
521		}
522	Ocast =>
523		n.op = Ocast;
524		left = efold(left);
525		n.left = left;
526		if(n.ty == left.ty || n.ty.kind == Tfix && tequal(n.ty, left.ty))
527			return left;
528		if(left.op == Oconst)
529			return foldcast(n, left);
530	Odot or
531	Omdot =>
532		#
533		# what about side effects from left?
534		#
535		d = right.decl;
536		case d.store{
537		Dconst or
538		Dtag or
539		Dtype =>
540			#
541			# set it up as a name and let that case do the hard work
542			#
543			n.op = Oname;
544			n.decl = d;
545			n.left = nil;
546			n.right = nil;
547			return efold(n);
548		}
549		n.left = efold(left);
550		if(n.left.op == Otuple)
551			n = tuplemem(n.left, d);
552		else
553			n.right = efold(right);
554	Otagof =>
555		if(n.decl != nil){
556			n.op = Oconst;
557			n.left = nil;
558			n.right = nil;
559			n.c = ref Const(big n.decl.tag, 0.);
560			return efold(n);
561		}
562		n.left = efold(left);
563	Oif =>
564		n.left = left = efold(left);
565		n.right = right = efold(right);
566		if(left.op == Oconst){
567			if(left.c.val != big 0)
568				return right.left;
569			else
570				return right.right;
571		}
572	* =>
573		n.left = efold(left);
574		n.right = efold(right);
575	}
576
577	left = n.left;
578	right = n.right;
579	if(left == nil)
580		return n;
581
582	if(right == nil){
583		if(left.op == Oconst){
584			if(left.ty == tint || left.ty == tbyte || left.ty == tbig)
585				return foldc(n);
586			if(left.ty == treal)
587				return foldr(n);
588		}
589		return n;
590	}
591
592	if(left.op == Oconst){
593		case n.op{
594		Olsh or
595		Orsh =>
596			if(left.c.val == big 0 && !hasside(right, 1))
597				return left;
598		Ooror =>
599			if(left.ty == tint || left.ty == tbyte || left.ty == tbig){
600				if(left.c.val == big 0){
601					n = mkbin(Oneq, right, mkconst(right.src, big 0));
602					n.ty = right.ty;
603					n.left.ty = right.ty;
604					return efold(n);
605				}
606				left.c.val = big 1;
607				return left;
608			}
609		Oandand =>
610			if(left.ty == tint || left.ty == tbyte || left.ty == tbig){
611				if(left.c.val == big 0)
612					return left;
613				n = mkbin(Oneq, right, mkconst(right.src, big 0));
614				n.ty = right.ty;
615				n.left.ty = right.ty;
616				return efold(n);
617			}
618		}
619	}
620	if(left.op == Oconst && right.op != Oconst
621	&& opcommute[n.op]
622	&& n.ty != tstring){
623		n.op = opcommute[n.op];
624		n.left = right;
625		n.right = left;
626		left = right;
627		right = n.right;
628	}
629	if(right.op == Oconst && left.op == n.op && left.right.op == Oconst
630	&& (n.op == Oadd || n.op == Omul || n.op == Oor || n.op == Oxor || n.op == Oand)
631	&& n.ty != tstring){
632		n.left = left.left;
633		left.left = right;
634		right = efold(left);
635		n.right = right;
636		left = n.left;
637	}
638	if(right.op == Oconst){
639		if(n.op == Oexp && left.ty == treal){
640			if(left.op == Oconst)
641				return foldr(n);
642			return n;
643		}
644		if(right.ty == tint || right.ty == tbyte || left.ty == tbig){
645			if(left.op == Oconst)
646				return foldc(n);
647			return foldvc(n);
648		}
649		if(right.ty == treal && left.op == Oconst)
650			return foldr(n);
651	}
652	if(sametree(left, right))
653		return folds(n);
654	return n;
655}
656
657#
658# does evaluating the node have any side effects?
659#
660hasside(n: ref Node, strict: int): int
661{
662	for(; n != nil; n = n.right){
663		if(sideeffect[n.op] && (strict || n.op != Oadr && n.op != Oind))
664			return 1;
665		if(hasside(n.left, strict))
666			return 1;
667	}
668	return 0;
669}
670
671hascall(n: ref Node): int
672{
673	for(; n != nil; n = n.right){
674		if(n.op == Ocall || n.op == Ospawn)
675			return 1;
676		if(hascall(n.left))
677			return 1;
678	}
679	return 0;
680}
681
682hasasgns(n: ref Node): int
683{
684	if(n == nil)
685		return 0;
686	if(n.op != Ocall && isused[n.op] && n.op != Onothing)
687		return 1;
688	return hasasgns(n.left) || hasasgns(n.right);
689}
690
691nodes(n: ref Node): int
692{
693	if(n == nil)
694		return 0;
695	return 1+nodes(n.left)+nodes(n.right);
696}
697
698foldcast(n, left: ref Node): ref Node
699{
700	case left.ty.kind{
701	Tint =>
702		left.c.val = big int left.c.val;
703		return foldcasti(n, left);
704	Tbyte =>
705		left.c.val = big byte left.c.val;
706		return foldcasti(n, left);
707	Tbig =>
708		return foldcasti(n, left);
709	Treal =>
710		case n.ty.kind{
711		Tint or
712		Tbyte or
713		Tbig =>
714			left.c.val = big left.c.rval;
715		Tfix =>
716			left.c.val = real2fix(left.c.rval, n.ty);
717		Tstring =>
718			return mksconst(n.src, enterstring(string left.c.rval));
719		* =>
720			return n;
721		}
722	Tfix =>
723		case n.ty.kind{
724		Tint or
725		Tbyte or
726		Tbig =>
727			left.c.val = big fix2real(left.c.val, left.ty);
728		Treal =>
729			left.c.rval = fix2real(left.c.val, left.ty);
730		Tfix =>
731			if(tequal(left.ty, n.ty))
732				return left;
733			left.c.val = fix2fix(left.c.val, left.ty, n.ty);
734		Tstring =>
735			return mksconst(n.src, enterstring(string fix2real(left.c.val, left.ty)));
736		* =>
737			return n;
738		}
739		break;
740	Tstring =>
741		case n.ty.kind{
742		Tint or
743		Tbyte or
744		Tbig =>
745			left.c = ref Const(big left.decl.sym.name, 0.);
746		Treal =>
747			left.c = ref Const(big 0, real left.decl.sym.name);
748		Tfix =>
749			left.c = ref Const(real2fix(real left.decl.sym.name, n.ty), 0.);
750		* =>
751			return n;
752		}
753	* =>
754		return n;
755	}
756	left.ty = n.ty;
757	left.src = n.src;
758	return left;
759}
760
761#
762# left is some kind of int type
763#
764foldcasti(n, left: ref Node): ref Node
765{
766	case n.ty.kind{
767	Tint =>
768		left.c.val = big int left.c.val;
769	Tbyte =>
770		left.c.val = big byte left.c.val;
771	Tbig =>
772		;
773	Treal =>
774		left.c.rval = real left.c.val;
775	Tfix =>
776		left.c.val = real2fix(real left.c.val, n.ty);
777	Tstring =>
778		return mksconst(n.src, enterstring(string left.c.val));
779	* =>
780		return n;
781	}
782	left.ty = n.ty;
783	left.src = n.src;
784	return left;
785}
786
787#
788# right is a const int
789#
790foldvc(n: ref Node): ref Node
791{
792	left := n.left;
793	right := n.right;
794	case n.op{
795	Oadd or
796	Osub or
797	Oor or
798	Oxor or
799	Olsh or
800	Orsh or
801	Ooror =>
802		if(right.c.val == big 0)
803			return left;
804		if(n.op == Ooror && !hasside(left, 1))
805			return right;
806	Oand =>
807		if(right.c.val == big 0 && !hasside(left, 1))
808			return right;
809	Omul =>
810		if(right.c.val == big 1)
811			return left;
812		if(right.c.val == big 0 && !hasside(left, 1))
813			return right;
814	Odiv =>
815		if(right.c.val == big 1)
816			return left;
817	Omod =>
818		if(right.c.val == big 1 && !hasside(left, 1)){
819			right.c.val = big 0;
820			return right;
821		}
822	Oexp =>
823		if(right.c.val == big 0){
824			right.c.val = big 1;
825			return right;
826		}
827		if(right.c.val == big 1)
828			return left;
829	Oandand =>
830		if(right.c.val != big 0)
831			return left;
832		if(!hasside(left, 1))
833			return right;
834	Oneq =>
835		if(!isrelop[left.op])
836			return n;
837		if(right.c.val == big 0)
838			return left;
839		n.op = Onot;
840		n.right = nil;
841	Oeq =>
842		if(!isrelop[left.op])
843			return n;
844		if(right.c.val != big 0)
845			return left;
846		n.op = Onot;
847		n.right = nil;
848	}
849	return n;
850}
851
852#
853# left and right are const ints
854#
855foldc(n: ref Node): ref Node
856{
857	v: big;
858	rv, nb: int;
859
860	left := n.left;
861	right := n.right;
862	case n.op{
863	Oadd =>
864		v = left.c.val + right.c.val;
865	Osub =>
866		v = left.c.val - right.c.val;
867	Omul =>
868		v = left.c.val * right.c.val;
869	Odiv =>
870		if(right.c.val == big 0){
871			nerror(n, "divide by 0 in constant expression");
872			return n;
873		}
874		v = left.c.val / right.c.val;
875	Omod =>
876		if(right.c.val == big 0){
877			nerror(n, "mod by 0 in constant expression");
878			return n;
879		}
880		v = left.c.val % right.c.val;
881	Oexp =>
882		if(left.c.val == big 0 && right.c.val < big 0){
883			nerror(n, "0 to negative power in constant expression");
884			return n;
885		}
886		v = ipow(left.c.val, int right.c.val);
887	Oand =>
888		v = left.c.val & right.c.val;
889	Oor =>
890		v = left.c.val | right.c.val;
891	Oxor =>
892		v = left.c.val ^ right.c.val;
893	Olsh =>
894		v = left.c.val;
895		rv = int right.c.val;
896		if(rv < 0 || rv >= n.ty.size * 8){
897			nwarn(n, "shift amount "+string rv+" out of range");
898			rv = 0;
899		}
900		if(rv == 0)
901			break;
902		v <<= rv;
903	Orsh =>
904		v = left.c.val;
905		rv = int right.c.val;
906		nb = n.ty.size * 8;
907		if(rv < 0 || rv >= nb){
908			nwarn(n, "shift amount "+string rv+" out of range");
909			rv = 0;
910		}
911		if(rv == 0)
912			break;
913		v >>= rv;
914	Oneg =>
915		v = -left.c.val;
916	Ocomp =>
917		v = ~left.c.val;
918	Oeq =>
919		v = big(left.c.val == right.c.val);
920	Oneq =>
921		v = big(left.c.val != right.c.val);
922	Ogt =>
923		v = big(left.c.val > right.c.val);
924	Ogeq =>
925		v = big(left.c.val >= right.c.val);
926	Olt =>
927		v = big(left.c.val < right.c.val);
928	Oleq =>
929		v = big(left.c.val <= right.c.val);
930	Oandand =>
931		v = big(int left.c.val && int right.c.val);
932	Ooror =>
933		v = big(int left.c.val || int right.c.val);
934	Onot =>
935		v = big(left.c.val == big 0);
936	* =>
937		return n;
938	}
939	if(n.ty == tint)
940		v = big int v;
941	else if(n.ty == tbyte)
942		v = big byte v;
943	n.left = nil;
944	n.right = nil;
945	n.decl = nil;
946	n.op = Oconst;
947	n.c = ref Const(v, 0.);
948	return n;
949}
950
951#
952# left and right are const reals
953#
954foldr(n: ref Node): ref Node
955{
956	rv := 0.;
957	v := big 0;
958
959	left := n.left;
960	right := n.right;
961	case n.op{
962	Ocast =>
963		return n;
964	Oadd =>
965		rv = left.c.rval + right.c.rval;
966	Osub =>
967		rv = left.c.rval - right.c.rval;
968	Omul =>
969		rv = left.c.rval * right.c.rval;
970	Odiv =>
971		rv = left.c.rval / right.c.rval;
972	Oexp =>
973		rv = rpow(left.c.rval, int right.c.val);
974	Oneg =>
975		rv = -left.c.rval;
976	Oinv =>
977		if(left.c.rval == 0.0){
978			error(n.src.start, "divide by 0 in fixed point type");
979			return n;
980		}
981		rv = 1.0/left.c.rval;
982	Oeq =>
983		v = big(left.c.rval == right.c.rval);
984	Oneq =>
985		v = big(left.c.rval != right.c.rval);
986	Ogt =>
987		v = big(left.c.rval > right.c.rval);
988	Ogeq =>
989		v = big(left.c.rval >= right.c.rval);
990	Olt =>
991		v = big(left.c.rval < right.c.rval);
992	Oleq =>
993		v = big(left.c.rval <= right.c.rval);
994	* =>
995		return n;
996	}
997	n.left = nil;
998	n.right = nil;
999	n.op = Oconst;
1000
1001	if(isnan(rv))
1002		rv = canonnan;
1003
1004	n.c = ref Const(v, rv);
1005	return n;
1006}
1007
1008varinit(d: ref Decl, e: ref Node): ref Node
1009{
1010	n := mkdeclname(e.src, d);
1011	if(d.next == nil)
1012		return mkbin(Oas, n, e);
1013	return mkbin(Oas, n, varinit(d.next, e));
1014}
1015
1016#
1017# given: an Oseq list with left == next or the last child
1018# make a list with the right == next
1019# ie: Oseq(Oseq(a, b),c) ==> Oseq(a, Oseq(b, Oseq(c, nil))))
1020#
1021rotater(e: ref Node): ref Node
1022{
1023	if(e == nil)
1024		return e;
1025	if(e.op != Oseq)
1026		return mkunary(Oseq, e);
1027	e.right = mkunary(Oseq, e.right);
1028	while(e.left.op == Oseq){
1029		left := e.left;
1030		e.left = left.right;
1031		left.right = e;
1032		e = left;
1033	}
1034	return e;
1035}
1036
1037#
1038# reverse the case labels list
1039#
1040caselist(s, nr: ref Node): ref Node
1041{
1042	r := s.right;
1043	s.right = nr;
1044	if(r == nil)
1045		return s;
1046	return caselist(r, s);
1047}
1048
1049#
1050# e is a seq of expressions; make into cons's to build a list
1051#
1052etolist(e: ref Node): ref Node
1053{
1054	if(e == nil)
1055		return nil;
1056	n := mknil(e.src);
1057	n.src.start = n.src.stop;
1058	if(e.op != Oseq)
1059		return mkbin(Ocons, e, n);
1060	e.right = mkbin(Ocons, e.right, n);
1061	while(e.left.op == Oseq){
1062		e.op = Ocons;
1063		left := e.left;
1064		e.left = left.right;
1065		left.right = e;
1066		e = left;
1067	}
1068	e.op = Ocons;
1069	return e;
1070}
1071
1072dupn(resrc: int, src: Src, n: ref Node): ref Node
1073{
1074	nn := ref *n;
1075	if(resrc)
1076		nn.src = src;
1077	if(nn.left != nil)
1078		nn.left = dupn(resrc, src, nn.left);
1079	if(nn.right != nil)
1080		nn.right = dupn(resrc, src, nn.right);
1081	return nn;
1082}
1083
1084mkn(op: int, left, right: ref Node): ref Node
1085{
1086	n := ref Node;
1087	n.op = op;
1088	n.flags = byte 0;
1089	n.left = left;
1090	n.right = right;
1091	return n;
1092}
1093
1094mkunary(op: int, left: ref Node): ref Node
1095{
1096	n := ref Node;
1097	n.src = left.src;
1098	n.op = op;
1099	n.flags = byte 0;
1100	n.left = left;
1101	return n;
1102}
1103
1104mkbin(op: int, left, right: ref Node): ref Node
1105{
1106	n := ref Node;
1107	n.src.start = left.src.start;
1108	n.src.stop = right.src.stop;
1109	n.op = op;
1110	n.flags = byte 0;
1111	n.left = left;
1112	n.right = right;
1113	return n;
1114}
1115
1116mkdeclname(src: Src, d: ref Decl): ref Node
1117{
1118	n := ref Node;
1119	n.src = src;
1120	n.op = Oname;
1121	n.flags = byte 0;
1122	n.decl = d;
1123	n.ty = d.ty;
1124	d.refs++;
1125	return n;
1126}
1127
1128mknil(src: Src): ref Node
1129{
1130	return mkdeclname(src, nildecl);
1131}
1132
1133mkname(src: Src, s: ref Sym): ref Node
1134{
1135	n := ref Node;
1136	n.src = src;
1137	n.op = Oname;
1138	n.flags = byte 0;
1139	if(s.unbound == nil){
1140		s.unbound = mkdecl(src, Dunbound, nil);
1141		s.unbound.sym = s;
1142	}
1143	n.decl = s.unbound;
1144	return n;
1145}
1146
1147mkconst(src: Src, v: big): ref Node
1148{
1149	n := ref Node;
1150	n.src = src;
1151	n.op = Oconst;
1152	n.flags = byte 0;
1153	n.ty = tint;
1154	n.c = ref Const(v, 0.);
1155	return n;
1156}
1157
1158mkrconst(src: Src, v: real): ref Node
1159{
1160	n := ref Node;
1161	n.src = src;
1162	n.op = Oconst;
1163	n.flags = byte 0;
1164	n.ty = treal;
1165	n.c = ref Const(big 0, v);
1166	return n;
1167}
1168
1169mksconst(src: Src, s: ref Sym): ref Node
1170{
1171	n := ref Node;
1172	n.src = src;
1173	n.op = Oconst;
1174	n.flags = byte 0;
1175	n.ty = tstring;
1176	n.decl = mkdecl(src, Dconst, tstring);
1177	n.decl.sym = s;
1178	return n;
1179}
1180
1181opconv(op: int): string
1182{
1183	if(op < 0 || op > Oend)
1184		return "op "+string op;
1185	return opname[op];
1186}
1187
1188etconv(n: ref Node): string
1189{
1190	s := expconv(n);
1191	if(n.ty == tany || n.ty == tnone || n.ty == terror)
1192		return s;
1193	s += " of type ";
1194	s += typeconv(n.ty);
1195	return s;
1196}
1197
1198expconv(n: ref Node): string
1199{
1200	return "'" + subexpconv(n) + "'";
1201}
1202
1203subexpconv(n: ref Node): string
1204{
1205	if(n == nil)
1206		return "";
1207	s := "";
1208	if(int n.flags & PARENS)
1209		s[len s] = '(';
1210	case n.op{
1211	Obreak or
1212	Ocont =>
1213		s += opname[n.op];
1214		if(n.decl != nil)
1215			s += " "+n.decl.sym.name;
1216	Oexit or
1217	Owild =>
1218		s += opname[n.op];
1219	Onothing =>
1220		;
1221	Oadr or
1222	Oused =>
1223		s += subexpconv(n.left);
1224	Oseq =>
1225		s += eprintlist(n, ", ");
1226	Oname =>
1227		if(n.decl == nil)
1228			s += "<nil>";
1229		else
1230			s += n.decl.sym.name;
1231	Oconst =>
1232		if(n.ty.kind == Tstring){
1233			s += stringpr(n.decl.sym);
1234			break;
1235		}
1236		if(n.decl != nil && n.decl.sym != nil){
1237			s += n.decl.sym.name;
1238			break;
1239		}
1240		case n.ty.kind{
1241		Tbig or
1242		Tint or
1243		Tbyte =>
1244			s += string n.c.val;
1245		Treal =>
1246			s += string n.c.rval;
1247		Tfix =>
1248			s += string n.c.val + "(" + string n.ty.val.c.rval + ")";
1249		* =>
1250			s += opname[n.op];
1251		}
1252	Ocast =>
1253		s += typeconv(n.ty);
1254		s[len s] = ' ';
1255		s += subexpconv(n.left);
1256	Otuple =>
1257		if(n.ty != nil && n.ty.kind == Tadt)
1258			s += n.ty.decl.sym.name;
1259		s[len s] = '(';
1260		s += eprintlist(n.left, ", ");
1261		s[len s] = ')';
1262	Ochan =>
1263		if(n.left != nil){
1264			s += "chan [";
1265			s += subexpconv(n.left);
1266			s += "] of ";
1267			s += typeconv(n.ty.tof);
1268		}
1269		else
1270			s += "chan of "+typeconv(n.ty.tof);
1271	Oarray =>
1272		s += "array [";
1273		if(n.left != nil)
1274			s += subexpconv(n.left);
1275		s += "] of ";
1276		if(n.right != nil){
1277			s += "{";
1278			s += eprintlist(n.right, ", ");
1279			s += "}";
1280		}else{
1281			s += typeconv(n.ty.tof);
1282		}
1283	Oelem or
1284	Olabel =>
1285		if(n.left != nil){
1286			s += eprintlist(n.left, " or ");
1287			s += " =>";
1288		}
1289		s += subexpconv(n.right);
1290	Orange =>
1291		s += subexpconv(n.left);
1292		s += " to ";
1293		s += subexpconv(n.right);
1294	Ospawn =>
1295		s += "spawn ";
1296		s += subexpconv(n.left);
1297	Oraise =>
1298		s += "raise ";
1299		s += subexpconv(n.left);
1300	Ocall =>
1301		s += subexpconv(n.left);
1302		s += "(";
1303		s += eprintlist(n.right, ", ");
1304		s += ")";
1305	Oinc or
1306	Odec =>
1307		s += subexpconv(n.left);
1308		s += opname[n.op];
1309	Oindex or
1310	Oindx or
1311	Oinds =>
1312		s += subexpconv(n.left);
1313		s += "[";
1314		s += subexpconv(n.right);
1315		s += "]";
1316	Oslice =>
1317		s += subexpconv(n.left);
1318		s += "[";
1319		s += subexpconv(n.right.left);
1320		s += ":";
1321		s += subexpconv(n.right.right);
1322		s += "]";
1323	Oload =>
1324		s += "load ";
1325		s += typeconv(n.ty);
1326		s += " ";
1327		s += subexpconv(n.left);
1328	Oref or
1329	Olen or
1330	Ohd or
1331	Otl or
1332	Otagof =>
1333		s += opname[n.op];
1334		s[len s] = ' ';
1335		s += subexpconv(n.left);
1336	* =>
1337		if(n.right == nil){
1338			s += opname[n.op];
1339			s += subexpconv(n.left);
1340		}else{
1341			s += subexpconv(n.left);
1342			s += opname[n.op];
1343			s += subexpconv(n.right);
1344		}
1345	}
1346	if(int n.flags & PARENS)
1347		s[len s] = ')';
1348	return s;
1349}
1350
1351eprintlist(elist: ref Node, sep: string): string
1352{
1353	if(elist == nil)
1354		return "";
1355	s := "";
1356	for(; elist.right != nil; elist = elist.right){
1357		if(elist.op == Onothing)
1358			continue;
1359		if(elist.left.op == Ofnptr)
1360			return s;
1361		s += subexpconv(elist.left);
1362		if(elist.right.left.op != Ofnptr)
1363			s += sep;
1364	}
1365	s += subexpconv(elist.left);
1366	return s;
1367}
1368
1369nodeconv(n: ref Node): string
1370{
1371	return nprint(n, 0);
1372}
1373
1374nprint(n: ref Node, indent: int): string
1375{
1376	if(n == nil)
1377		return "";
1378	s := "\n";
1379	for(i := 0; i < indent; i++)
1380		s[len s] = ' ';
1381	case n.op{
1382	Oname =>
1383		if(n.decl == nil)
1384			s += "<nil>";
1385		else
1386			s += n.decl.sym.name;
1387	Oconst =>
1388		if(n.decl != nil && n.decl.sym != nil)
1389			s += n.decl.sym.name;
1390		else
1391			s += opconv(n.op);
1392		if(n.ty == tint || n.ty == tbyte || n.ty == tbig)
1393			s += " (" + string n.c.val + ")";
1394	* =>
1395		s += opconv(n.op);
1396	}
1397	s += " " + typeconv(n.ty) + " " + string n.addable + " " + string n.temps;
1398	indent += 2;
1399	s += nprint(n.left, indent);
1400	s += nprint(n.right, indent);
1401	return s;
1402}
1403