![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to mcprint.sml CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / sml / src / translate|
Return to mcprint.sml CVS log | Up to [Research Unix] / researchv10no / cmd / sml / src / translate |
1.1 root 1: (* Copyright 1989 by AT&T Bell Laboratories *)
2: (* mcprint.sml *)
3:
4: signature MCprint =
5: sig
6: structure Access : ACCESS
7: structure A : BAREABSYN
8: structure L : LAMBDA
9: val printCon : L.con -> unit
10: val printLexp : L.lexp -> unit
11: val printMatch : (A.pat * L.lexp) list -> unit
12: val printFun : L.lexp -> Access.lvar -> unit
13: end
14:
15: structure MCprint : MCprint = struct
16:
17: structure Access = Access
18: structure A = BareAbsyn
19: structure L = Lambda
20:
21: open Access Basics A L PrintUtil PrintBasics PrintAbsyn ErrorMsg
22: val margin = ref 0
23:
24: fun indent i = margin := !margin + i
25:
26: exception Undent
27:
28: fun undent i = (margin := !margin - i; if !margin < 0 then raise Undent else ())
29:
30: fun dent () = tab(!margin)
31:
32: fun printCon (DATAcon dcon) = printDcon dcon
33: | printCon (INTcon i) = print i
34: | printCon (REALcon r) = print r
35: | printCon (STRINGcon s) = pr_mlstr s
36:
37: (* use of complex in printLexp may lead to stupid n^2 behavior. *)
38: val rec complex =
39: fn VAR w => false
40: | FN(_,b) => complex b
41: | FIX(vl,ll,b) => true
42: | APP(FN _,_) => true
43: | APP(l,r) => complex l orelse complex r
44: | SWITCH (l,ls,d) => true
45: | RECORD l => let fun f nil = false | f (hd::tl) = complex hd orelse f tl
46: in f l
47: end
48: | SELECT(_,l) => complex l
49: | HANDLE _ => true | RAISE l => complex l
50: | INT _ => false | STRING _ => false | REAL _ => false
51: | PRIM _ => false
52: fun printLexp (VAR v) = print(lvarName v)
53: | printLexp (INT i) = print i
54: | printLexp (REAL s) = print s
55: | printLexp (STRING s) = pr_mlstr s
56: | printLexp (r as RECORD l) =
57: if complex r
58: then (print "RECORD";
59: indent 7;
60: printTuple (fn l => (printLexp l; newline(); dent())) l;
61: undent 7)
62: else (print "RECORD"; printTuple printLexp l)
63: | printLexp (PRIM p) = print ("PRIM "^Prim.inLineName p)
64: | printLexp (l as SELECT(i,_)) =
65: let fun gather(SELECT(i,l)) =
66: let val (more,root) = gather l
67: in (i :: more,root)
68: end
69: | gather l = (nil,l)
70: val (path,root) = gather l
71: fun ipr (i:int) = print i
72: in printLexp root;
73: printClosedSequence ("[",",","]") ipr (rev path)
74: end
75: | printLexp (FN(v,l)) =
76: (print "FN("; print(lvarName v); print ",";
77: if complex l then (newline(); indent 3; dent();
78: printLexp l; print ")"; undent 3)
79: else (printLexp l; print ")")
80: )
81: | printLexp (APP(FN(v,l),r)) =
82: let val lv = lvarName v
83: val len = size lv + 3
84: in print lv; print " = ";
85: indent len ; printLexp r; undent len;
86: newline(); dent(); printLexp l
87: end
88: | printLexp (APP(l,r)) =
89: (print "APP(";
90: if complex l orelse complex r
91: then (indent 4; printLexp l; print ",\n"; dent();
92: printLexp r; print ")"; undent 4)
93: else (printLexp l; print ",";
94: printLexp r; print ")"))
95: | printLexp (SWITCH (l,llist,default)) =
96: let fun switch [(c,l)] =
97: (printCon c; print " => ";
98: indent 8; printLexp l; undent 8)
99: | switch ((c,l)::more) =
100: (printCon c; print " => ";
101: indent 8; printLexp l; undent 8; newline(); dent();
102: switch more)
103: in print "SWITCH ";
104: indent 7;
105: printLexp l;
106: undent 6;
107: newline(); dent();
108: print "of "; indent 3;
109: switch llist;
110: case (default,llist)
111: of (NONE,_) => ()
112: | (SOME l,nil) =>
113: (print "_ => ";
114: indent 5; printLexp l; undent 5)
115: | (SOME l,_) =>
116: (newline(); dent(); print "_ => ";
117: indent 5; printLexp l; undent 5);
118: undent 4
119: end
120: | printLexp (FIX (varlist,lexplist,lexp)) =
121: let fun flist([v],[l]) =
122: let val lv = lvarName v
123: val len = size lv + 2
124: in print lv; print ": ";
125: indent len ; printLexp l; undent len
126: end
127: | flist(v::vs,l::ls) =
128: let val lv = lvarName v
129: val len = size lv + 2
130: in print lv; print ": ";
131: indent len ; printLexp l; undent len;
132: newline(); dent(); flist(vs,ls)
133: end
134: | flist(nil,nil) = ()
135: in print "FIX("; indent 4; flist(varlist,lexplist); undent 4;
136: newline(); dent(); print "IN ";
137: indent 4; printLexp lexp; print ")"; undent 4
138: end
139: | printLexp (RAISE l) = (print "RAISE "; indent 6; printLexp l; undent 6)
140: | printLexp (HANDLE (lexp,withlexp)) =
141: (print "HANDLE "; indent 7; printLexp lexp;
142: undent 5; newline(); dent();
143: print "WITH "; indent 5; printLexp withlexp; undent 7)
144:
145: fun printMatch ((p,r)::more) =
146: (printPat(p,!System.Control.Print.printDepth);
147: print " => "; printLexp r; newline(); printMatch more)
148: | printMatch nil = ()
149:
150: fun printFun l v =
151: let val rec findit =
152: fn VAR w => if v=w
153: then (print("VAR " ^ lvarName v ^ " is free in <lexp>\n");
154: ())
155: else ()
156: | l as FN(w,b) => if v=w then printLexp l else findit b
157: | l as FIX(vl,ll,b) => if exists (fn w => v=w) vl
158: then printLexp l
159: else (app findit ll; findit b)
160: | APP(l,r) => (findit l; findit r)
161: | SWITCH (l,ls,d) =>
162: (findit l;
163: app (fn(_,l) => findit l) ls;
164: case d of NONE => () | SOME l => findit l)
165: | RECORD l => app findit l | SELECT(_,l) => findit l
166: | HANDLE(e,h) => (findit e; findit h) | RAISE l => findit l
167: | INT _ => () | STRING _ => () | REAL _ => ()
168: | PRIM _ => ()
169: in findit l
170: end
171:
172:
173: end (* struct MCprint *)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.