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     ! 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.