Return to cpsprint.sml CVS log

Up to [Research Unix] / researchv10no / cmd / sml / src / cps

Annotation of researchv10no/cmd/sml/src/cps/cpsprint.sml, revision 1.1.1.1

1.1       root        1: (* Copyright 1989 by AT&T Bell Laboratories *)
                      2: structure CPSprint =
                      3: struct
                      4: 
                      5: open CPS Prim
                      6: 
                      7: fun show say ctable =
                      8:   let fun sayv v =
                      9:        (case ctable v
                     10:          of INTconst i => say(makestring i)
                     11:           | REALconst r => say r
                     12:           | STRINGconst s => (say "\""; say s; say "\"")
                     13:        ) handle Ctable => say (Access.lvarName v)
                     14:       fun sayvlist [v] = sayv v
                     15:         | sayvlist nil = ()
                     16:        | sayvlist (v::vl) = (sayv v; say ","; sayvlist vl)
                     17:       fun saypath(OFFp 0) = ()
                     18:        | saypath(OFFp i) = (say "+"; say(makestring i))
                     19:        | saypath(SELp(j,p)) = (say "."; say(makestring j); saypath p)
                     20:       fun sayvp (v,path) = (sayv v; saypath path)
                     21:       fun saylist f [x] = f x | saylist f nil = () 
                     22:        | saylist f (x::r) = (f x; say ","; saylist f r)
                     23:       fun indent n =
                     24:        let fun space 0 = () | space k = (say " "; space(k-1))
                     25:            fun nl() = say "\n"
                     26:            val rec f =
                     27:             fn RECORD(vl,v,c) =>
                     28:                    (space n; say "{"; saylist sayvp vl; say "} -> "; sayv v;
                     29:                     nl(); f c)
                     30:              | SELECT(i,v,w,c) =>
                     31:                    (space n; sayv v; say "."; say(makestring i); say " -> ";
                     32:                     sayv w; nl(); f c)
                     33:              | OFFSET(i,v,w,c) =>
                     34:                    (space n; sayv v; say "+"; say(makestring i); say " -> ";
                     35:                    sayv w; nl(); f c)
                     36:              | APP(w,vl) => 
                     37:                    (space n; sayv w; say "("; sayvlist vl; say ")\n")
                     38:              | FIX(bl,c) =>
                     39:                    let fun g(v,wl,d) = 
                     40:                            (space n; sayv v; say "("; sayvlist wl;
                     41:                             say ") =\n"; indent (n+3) d)
                     42:                     in app g bl; f c
                     43:                    end
                     44:              | SWITCH(v,cl) =>
                     45:                   let fun g(i,c::cl) =
                     46:                        (space(n+1); say(makestring(i:int));
                     47:                         say " =>\n"; indent (n+3) c; g(i+1,cl))
                     48:                         | g(_,nil) = ()
                     49:                    in space n; say "case "; sayv v; say " of\n"; g(0,cl)
                     50:                   end
                     51:              | PRIMOP(_,nil,nil,nil) => ()
                     52:              | PRIMOP(i,vl,wl,[c]) =>
                     53:                   (space n; say(inLineName i); say "("; sayvlist vl;
                     54:                    say ") -> "; sayvlist wl; nl(); f c)
                     55:              | PRIMOP(i,vl,nil,[t,f]) =>
                     56:                  (space n; say "if "; say(inLineName i);
                     57:                         say "("; sayvlist vl; say ") then\n";
                     58:                    indent (n+3) t;
                     59:                    space n; say "else\n";
                     60:                    indent (n+3) f
                     61:                   )
                     62:              | PRIMOP(i,vl,wl,cl) =>
                     63:                  (space n; say "case "; say(inLineName i);
                     64:                         say "("; sayvlist vl; say ") -> ";
                     65:                        sayvlist wl; say " of\n";
                     66:                   let fun g(i,c::cl) =
                     67:                        (space(n+1); say(makestring i); say " =>\n";
                     68:                            indent (n+3) c; g(i+1,cl))
                     69:                         | g(_,nil) = ()
                     70:                    in g(0,cl)
                     71:                   end)
                     72:          in f
                     73:         end
                     74:  in  indent 0
                     75:  end
                     76: end

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.