Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/branches/SMLNJ/src/compiler/FLINT/flint/ppflint.sml
ViewVC logotype

Diff of /sml/branches/SMLNJ/src/compiler/FLINT/flint/ppflint.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 23, Thu Mar 12 00:49:56 1998 UTC revision 24, Thu Mar 12 00:49:58 1998 UTC
# Line 6  Line 6 
6  struct  struct
7      (** frequently used structures *)      (** frequently used structures *)
8      structure F = FLINT      structure F = FLINT
     structure FU = FlintUtil  
9      structure S = Symbol      structure S = Symbol
10      structure LV = LambdaVar      structure LV = LambdaVar
11      structure LT = LtyExtern      structure LT = LtyExtern
# Line 27  Line 26 
26      infix &      infix &
27      fun op& (f1,f2) () = (f1(); f2())      fun op& (f1,f2) () = (f1(); f2())
28    
29    
30      (** classifications of various kinds of functions: not used *)      (** classifications of various kinds of functions: not used *)
31      fun toStringFKind (F.FK_FUN {isrec=SOME _, ...} : F.fkind) = "FK_REC"      fun toStringFKind ({isrec=SOME _, ...} : F.fkind) = "FK_REC"
32        | toStringFKind (F.FK_FUN _) = "FK_FUN"        | toStringFKind {isrec=_, ...} = "FK_ESCAPE"
       | toStringFKind (F.FK_FCT) = "FK_FCT"  
33  (*  (*
34      fun toStringFKind F.FK_ESCAPE  = "FK_ESCAPE"      fun toStringFKind F.FK_ESCAPE  = "FK_ESCAPE"
35        | toStringFKind F.FK_KNOWN   = "FK_KNOWN"        | toStringFKind F.FK_KNOWN   = "FK_KNOWN"
# Line 44  Line 43 
43    
44      (** classifications of various kinds of records *)      (** classifications of various kinds of records *)
45      fun toStringRKind (F.RK_VECTOR tyc) = "VECTOR[" ^ LT.tc_print tyc ^ "]"      fun toStringRKind (F.RK_VECTOR tyc) = "VECTOR[" ^ LT.tc_print tyc ^ "]"
46          | toStringRKind F.RK_RECORD = "RECORD"
47        | toStringRKind F.RK_STRUCT = "STRUCT"        | toStringRKind F.RK_STRUCT = "STRUCT"
       | toStringRKind (F.RK_TUPLE _) = "RECORD"  
48    
49      val printRKind = say o toStringRKind      val printRKind = say o toStringRKind
50    
# Line 85  Line 84 
84      val printLtyList = PU.printClosedSequence parenCommaSep printLty      val printLtyList = PU.printClosedSequence parenCommaSep printLty
85      val printTvTkList = PU.printClosedSequence ("[",",","]") printTvTk      val printTvTkList = PU.printClosedSequence ("[",",","]") printTvTk
86    
87      fun printDecon (F.DATAcon((_,Access.CONSTANT _,_),_,_)) = ()      fun appPrint prfun sepfun [] = ()
88          (* WARNING: a hack, but then what about constant exceptions ? *)        | appPrint prfun sepfun (x::xs) =
89        | printDecon (F.DATAcon((symbol,conrep,lty),tycs,lvar)) =          (prfun x;  app (fn y => (sepfun(); prfun y)) xs)
90          (* <lvar> = DECON(<symbol>,<conrep>,<lty>,[<tycs>]) *)  
91          (printVar lvar;      fun printDecon (F.DATAcon(_,_,[])) = ()
92          | printDecon (F.DATAcon((symbol,conrep,lty),tycs,lvars)) =
93            (* [<lvars>] = DECON(<symbol>,<conrep>,<lty>,[<tycs>]) *)
94            (printVarList lvars;
95           say " = DECON(";           say " = DECON(";
96           say (S.name symbol); say ",";           say (S.name symbol); say ",";
97           say (Access.prRep conrep); say ",";           say (Access.prRep conrep); say ",";
# Line 98  Line 100 
100           newline(); dent())           newline(); dent())
101        | printDecon _ = ()        | printDecon _ = ()
102    
     fun appPrint prfun sepfun [] = ()  
       | appPrint prfun sepfun (x::xs) =  
         (prfun x;  app (fn y => (sepfun(); prfun y)) xs)  
   
103      (** the definitions of the lambda expressions *)      (** the definitions of the lambda expressions *)
104    
105      fun complex (F.LET _) = true      fun complex (F.LET _) = true
# Line 203  Line 201 
201                        pLexp lexp;  undent 4);                        pLexp lexp;  undent 4);
202                        undent 2)                        undent 2)
203    
204        | pLexp (F.CON ((symbol,_,_), tycs, value, lvar, body)) =        | pLexp (F.CON ((symbol,_,_), tycs, values, lvar, body)) =
205           (* <lvar> = CON(<symbol>, <tycs>, <value>)           (* <lvar> = CON(<symbol>, <tycs>, <values>)
206            * <body>            * <body>
207            *)            *)
208           (printVar lvar; say " = CON(";           (printVar lvar; say " = CON(";
209            say (S.name symbol); say ", ";            say (S.name symbol); say ", ";
210            printTycList tycs;  say ", ";            printTycList tycs;  say ", ";
211            printSval value;  say ")";            printValList values;  say ")";
212            newline();  dent();  pLexp body)            newline();  dent();  pLexp body)
213    
214        | pLexp (F.RECORD (rkind, values, lvar, body)) =        | pLexp (F.RECORD (rkind, values, lvar, body)) =
# Line 233  Line 231 
231    
232        | pLexp (F.RAISE (value, ltys)) =        | pLexp (F.RAISE (value, ltys)) =
233           (* NOTE: I'm ignoring the lty list here. It is the return type           (* NOTE: I'm ignoring the lty list here. It is the return type
234            * of the raise expression. (ltys temporarily being printed --v)            * of the raise expression.
235            *)            *)
236           (* RAISE(<value>) *)           (* RAISE(<value>) *)
237           (say "RAISE(";           (say "RAISE(";
238            printSval value; say ") : "; printLtyList ltys)            printSval value; say ")")
239    
240        | pLexp (F.HANDLE (body, value)) =        | pLexp (F.HANDLE (body, value)) =
241           (* <body>           (* <body>
# Line 247  Line 245 
245            newline();  dent();            newline();  dent();
246            say "HANDLE(";  printSval value;  say ")")            say "HANDLE(";  printSval value;  say ")")
247    
248        | pLexp (F.BRANCH ((d, primop, lty, tycs), values, body1, body2)) =        | pLexp (F.ETAG (tyc, value, lvar, body)) =
249           (* IF PRIM(<primop>, <lty>, [<tycs>]) [<values>] THEN           (* <lvar> = ETAG(<value>[<tyc>])
250            *   <body1>            * <body>
251            * ELSE            *)
252            *   <body2>           (printVar lvar;  say " = ETAG(";
253              printSval value;  say "[";
254              printTyc tyc;  say "])";
255              newline();  dent();  pLexp body)
256    
257          | pLexp (F.PRIMOP ((primop, lty, tycs), values, lvar, body)) =
258             (* <lvar> = PRIM(<primop>, <lty>, [<tycs>]) [<values>]
259              * <body>
260            *)            *)
261           ((case d of NONE => say "IF PRIMOP("           (printVar lvar;  say " = PRIMOP(";
                    | _ => say "IF GENOP(");  
262            say (PO.prPrimop primop);  say ", ";            say (PO.prPrimop primop);  say ", ";
263            printLty lty;  say ", ";            printLty lty;  say ", ";
264            printTycList tycs;  say ") ";            printTycList tycs;  say ") ";
265            printValList values;            printValList values;
266            say " THEN";            newline();  dent();  pLexp body)
           newline();  dent(); pLexp body1;  
           newline();  say "ELSE";  
           newline();  dent(); pLexp body2)  
267    
268        | pLexp (F.PRIMOP (p as (_, PO.MKETAG, _, _), [value], lvar, body)) =        | pLexp (F.GENOP (dict, (primop, lty, tycs), values, lvar, body)) =
269           (* <lvar> = ETAG(<value>[<tyc>])           (* NOTE: I'm ignoring the `dict' here. *)
270             (* <lvar> = GENOP(<primop>, <lty>, [<tycs>]) [<values>]
271            * <body>            * <body>
272            *)            *)
273           (printVar lvar;  say " = ETAG(";           (printVar lvar;  say " = GENOP(";
274            printSval value;  say "[";            say (PO.prPrimop primop);  say ", ";
275            printTyc (FU.getEtagTyc p);  say "])";            printLty lty;  say ", ";
276              printTycList tycs;  say ") ";
277              printValList values;
278            newline();  dent();  pLexp body)            newline();  dent();  pLexp body)
279    
280        | pLexp (F.PRIMOP (p as (_, PO.WRAP, _, _), [value], lvar, body)) =        | pLexp (F.WRAP (tyc, value, lvar, body)) =
281           (* <lvar> = WRAP(<tyc>, <value>)           (* <lvar> = WRAP(<tyc>, <value>)
282            * <body>            * <body>
283            *)            *)
284           (printVar lvar;  say " = WRAP(";           (printVar lvar;  say " = WRAP(";
285            printTyc (FU.getWrapTyc p);  say ", ";            printTyc tyc;  say ", ";
286            printSval value;  say ")";            printSval value;  say ")";
287            newline();  dent();  pLexp body)            newline();  dent();  pLexp body)
288    
289        | pLexp (F.PRIMOP (p as (_, PO.UNWRAP, _, []), [value], lvar, body)) =        | pLexp (F.UNWRAP (tyc, value, lvar, body)) =
290           (* <lvar> = UNWRAP(<tyc>, <value>)           (* <lvar> = UNWRAP(<tyc>, <value>)
291            * <body>            * <body>
292            *)            *)
293           (printVar lvar;  say " = UNWRAP(";           (printVar lvar;  say " = UNWRAP(";
294            printTyc (FU.getUnWrapTyc p);  say ", ";            printTyc tyc;  say ", ";
295            printSval value;  say ")";            printSval value;  say ")";
296            newline();  dent();  pLexp body)            newline();  dent();  pLexp body)
297    
       | pLexp (F.PRIMOP ((d, primop, lty, tycs), values, lvar, body)) =  
          (* <lvar> = PRIM(<primop>, <lty>, [<tycs>]) [<values>]  
           * <body>  
           *)  
          (printVar lvar;  
           (case d of NONE => say " = PRIMOP("  
                    | _ => say " = GENOP(");  
           say (PO.prPrimop primop);  say ", ";  
           printLty lty;  say ", ";  
           printTycList tycs;  say ") ";  
           printValList values;  
           newline();  dent();  pLexp body)  
   
298      and printFundec (fkind, lvar, lvar_lty_list, body) =      and printFundec (fkind, lvar, lvar_lty_list, body) =
299          (*  <lvar> : (<fkind>) <lty> =          (*  <lvar> : (<fkind>) <lty> =
300           *    FN([v1 : lty1,           *    FN([v1 : lty1,
# Line 325  Line 316 
316                     app (fn (lvar,lty) =>                     app (fn (lvar,lty) =>
317                          (say ","; newline(); dent();                          (say ","; newline(); dent();
318                           printVar lvar; say " : "; printLty lty)) L));                           printVar lvar; say " : "; printLty lty)) L));
319                say "],"; newline();                print "],"; newline();
320                undent 2;  dent();                undent 2;  dent();
321                pLexp body; say ")";                pLexp body;
322                undent 4)                undent 4)
323    
324      and printCase (con, lexp) =      and printCase (con, lexp) =
# Line 339  Line 330 
330    
331      fun printLexp lexp = pLexp lexp before (newline(); newline())      fun printLexp lexp = pLexp lexp before (newline(); newline())
332    
     fun printProg prog = (printFundec prog; newline())  
   
333    
334  end (* structure PPFlint *)  end (* structure PPFlint *)
335    

Legend:
Removed from v.23  
changed lines
  Added in v.24

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0