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/trunk/src/compiler/FLINT/flint/ppflint.sml
ViewVC logotype

Diff of /sml/trunk/src/compiler/FLINT/flint/ppflint.sml

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

revision 46, Sun Mar 22 20:11:09 1998 UTC revision 47, Sun Mar 22 21:53:07 1998 UTC
# Line 6  Line 6 
6  struct  struct
7      (** frequently used structures *)      (** frequently used structures *)
8      structure F = FLINT      structure F = FLINT
9        structure FU = FlintUtil
10      structure S = Symbol      structure S = Symbol
11      structure LV = LambdaVar      structure LV = LambdaVar
12      structure LT = LtyExtern      structure LT = LtyExtern
# Line 26  Line 27 
27      infix &      infix &
28      fun op& (f1,f2) () = (f1(); f2())      fun op& (f1,f2) () = (f1(); f2())
29    
30        fun toStringFFlag ff =
31      (** classifications of various kinds of functions: not used *)        let fun h b = if b then "r" else "c"
32      fun toStringFKind ({isrec=SOME _, ...} : F.fkind) = "FK_REC"         in LT.ffw_var (ff, fn (b1,b2) => (h b1)^(h b2), fn _ => "f")
33        | toStringFKind {isrec=_, ...} = "FK_ESCAPE"        end
34    
35        fun toStringFKind (F.FK_FUN {isrec=SOME _, fixed, ...} : F.fkind) =
36              "REC " ^ (toStringFFlag fixed)
37          | toStringFKind (F.FK_FUN {fixed, ...}) =
38              "FUN " ^ (toStringFFlag fixed)
39          | toStringFKind (F.FK_FCT) = "FCT"
40  (*  (*
41      fun toStringFKind F.FK_ESCAPE  = "FK_ESCAPE"      fun toStringFKind F.FK_ESCAPE  = "FK_ESCAPE"
42        | toStringFKind F.FK_KNOWN   = "FK_KNOWN"        | toStringFKind F.FK_KNOWN   = "FK_KNOWN"
# Line 43  Line 50 
50    
51      (** classifications of various kinds of records *)      (** classifications of various kinds of records *)
52      fun toStringRKind (F.RK_VECTOR tyc) = "VECTOR[" ^ LT.tc_print tyc ^ "]"      fun toStringRKind (F.RK_VECTOR tyc) = "VECTOR[" ^ LT.tc_print tyc ^ "]"
       | toStringRKind F.RK_RECORD = "RECORD"  
53        | toStringRKind F.RK_STRUCT = "STRUCT"        | toStringRKind F.RK_STRUCT = "STRUCT"
54          | toStringRKind (F.RK_TUPLE _) = "RECORD"
55    
56      val printRKind = say o toStringRKind      val printRKind = say o toStringRKind
57    
# Line 85  Line 92 
92      val printLtyList = PU.printClosedSequence parenCommaSep printLty      val printLtyList = PU.printClosedSequence parenCommaSep printLty
93      val printTvTkList = PU.printClosedSequence ("[",",","]") printTvTk      val printTvTkList = PU.printClosedSequence ("[",",","]") printTvTk
94    
95      fun appPrint prfun sepfun [] = ()      fun printDecon (F.DATAcon((_,Access.CONSTANT _,_),_,_)) = ()
96        | appPrint prfun sepfun (x::xs) =          (* WARNING: a hack, but then what about constant exceptions ? *)
97          (prfun x;  app (fn y => (sepfun(); prfun y)) xs)        | printDecon (F.DATAcon((symbol,conrep,lty),tycs,lvar)) =
98            (* <lvar> = DECON(<symbol>,<conrep>,<lty>,[<tycs>]) *)
99      fun printDecon (F.DATAcon(_,_,[])) = ()          (printVar lvar;
       | printDecon (F.DATAcon((symbol,conrep,lty),tycs,lvars)) =  
         (* [<lvars>] = DECON(<symbol>,<conrep>,<lty>,[<tycs>]) *)  
         (printVarList lvars;  
100           say " = DECON(";           say " = DECON(";
101           say (S.name symbol); say ",";           say (S.name symbol); say ",";
102           say (Access.prRep conrep); say ",";           say (Access.prRep conrep); say ",";
# Line 101  Line 105 
105           newline(); dent())           newline(); dent())
106        | printDecon _ = ()        | printDecon _ = ()
107    
108        fun appPrint prfun sepfun [] = ()
109          | appPrint prfun sepfun (x::xs) =
110            (prfun x;  app (fn y => (sepfun(); prfun y)) xs)
111    
112      (** the definitions of the lambda expressions *)      (** the definitions of the lambda expressions *)
113    
114      fun complex (F.LET _) = true      fun complex (F.LET _) = true
# Line 202  Line 210 
210                        pLexp lexp;  undent 4);                        pLexp lexp;  undent 4);
211                        undent 2)                        undent 2)
212    
213        | pLexp (F.CON ((symbol,_,_), tycs, values, lvar, body)) =        | pLexp (F.CON ((symbol,_,_), tycs, value, lvar, body)) =
214           (* <lvar> = CON(<symbol>, <tycs>, <values>)           (* <lvar> = CON(<symbol>, <tycs>, <value>)
215            * <body>            * <body>
216            *)            *)
217           (printVar lvar; say " = CON(";           (printVar lvar; say " = CON(";
218            say (S.name symbol); say ", ";            say (S.name symbol); say ", ";
219            printTycList tycs;  say ", ";            printTycList tycs;  say ", ";
220            printValList values;  say ")";            printSval value;  say ")";
221            newline();  dent();  pLexp body)            newline();  dent();  pLexp body)
222    
223        | pLexp (F.RECORD (rkind, values, lvar, body)) =        | pLexp (F.RECORD (rkind, values, lvar, body)) =
# Line 232  Line 240 
240    
241        | pLexp (F.RAISE (value, ltys)) =        | pLexp (F.RAISE (value, ltys)) =
242           (* 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
243            * of the raise expression.            * of the raise expression. (ltys temporarily being printed --v)
244            *)            *)
245           (* RAISE(<value>) *)           (* RAISE(<value>) *)
246           (say "RAISE(";           (say "RAISE(";
247            printSval value; say ")")            printSval value; say ") : "; printLtyList ltys)
248    
249        | pLexp (F.HANDLE (body, value)) =        | pLexp (F.HANDLE (body, value)) =
250           (* <body>           (* <body>
# Line 246  Line 254 
254            newline();  dent();            newline();  dent();
255            say "HANDLE(";  printSval value;  say ")")            say "HANDLE(";  printSval value;  say ")")
256    
257        | pLexp (F.ETAG (tyc, value, lvar, body)) =        | pLexp (F.BRANCH ((d, primop, lty, tycs), values, body1, body2)) =
258           (* <lvar> = ETAG(<value>[<tyc>])           (* IF PRIM(<primop>, <lty>, [<tycs>]) [<values>] THEN
259            * <body>            *   <body1>
260            *)            * ELSE
261           (printVar lvar;  say " = ETAG(";            *   <body2>
           printSval value;  say "[";  
           printTyc tyc;  say "])";  
           newline();  dent();  pLexp body)  
   
       | pLexp (F.PRIMOP ((primop, lty, tycs), values, lvar, body)) =  
          (* <lvar> = PRIM(<primop>, <lty>, [<tycs>]) [<values>]  
           * <body>  
262            *)            *)
263           (printVar lvar;  say " = PRIMOP(";           ((case d of NONE => say "IF PRIMOP("
264                       | _ => say "IF GENOP(");
265            say (PO.prPrimop primop);  say ", ";            say (PO.prPrimop primop);  say ", ";
266            printLty lty;  say ", ";            printLty lty;  say ", ";
267            printTycList tycs;  say ") ";            printTycList tycs;  say ") ";
268            printValList values;            printValList values;
269            newline();  dent();  pLexp body)            say " THEN";
270              newline();  dent(); pLexp body1;
271              newline();  say "ELSE";
272              newline();  dent(); pLexp body2)
273    
274        | pLexp (F.GENOP (dict, (primop, lty, tycs), values, lvar, body)) =        | pLexp (F.PRIMOP (p as (_, PO.MKETAG, _, _), [value], lvar, body)) =
275           (* NOTE: I'm ignoring the `dict' here. *)           (* <lvar> = ETAG(<value>[<tyc>])
          (* <lvar> = GENOP(<primop>, <lty>, [<tycs>]) [<values>]  
276            * <body>            * <body>
277            *)            *)
278           (printVar lvar;  say " = GENOP(";           (printVar lvar;  say " = ETAG(";
279            say (PO.prPrimop primop);  say ", ";            printSval value;  say "[";
280            printLty lty;  say ", ";            printTyc (FU.getEtagTyc p);  say "])";
           printTycList tycs;  say ") ";  
           printValList values;  
281            newline();  dent();  pLexp body)            newline();  dent();  pLexp body)
282    
283        | pLexp (F.WRAP (tyc, value, lvar, body)) =        | pLexp (F.PRIMOP (p as (_, PO.WRAP, _, _), [value], lvar, body)) =
284           (* <lvar> = WRAP(<tyc>, <value>)           (* <lvar> = WRAP(<tyc>, <value>)
285            * <body>            * <body>
286            *)            *)
287           (printVar lvar;  say " = WRAP(";           (printVar lvar;  say " = WRAP(";
288            printTyc tyc;  say ", ";            printTyc (FU.getWrapTyc p);  say ", ";
289            printSval value;  say ")";            printSval value;  say ")";
290            newline();  dent();  pLexp body)            newline();  dent();  pLexp body)
291    
292        | pLexp (F.UNWRAP (tyc, value, lvar, body)) =        | pLexp (F.PRIMOP (p as (_, PO.UNWRAP, _, []), [value], lvar, body)) =
293           (* <lvar> = UNWRAP(<tyc>, <value>)           (* <lvar> = UNWRAP(<tyc>, <value>)
294            * <body>            * <body>
295            *)            *)
296           (printVar lvar;  say " = UNWRAP(";           (printVar lvar;  say " = UNWRAP(";
297            printTyc tyc;  say ", ";            printTyc (FU.getUnWrapTyc p);  say ", ";
298            printSval value;  say ")";            printSval value;  say ")";
299            newline();  dent();  pLexp body)            newline();  dent();  pLexp body)
300    
301          | pLexp (F.PRIMOP ((d, primop, lty, tycs), values, lvar, body)) =
302             (* <lvar> = PRIM(<primop>, <lty>, [<tycs>]) [<values>]
303              * <body>
304              *)
305             (printVar lvar;
306              (case d of NONE => say " = PRIMOP("
307                       | _ => say " = GENOP(");
308              say (PO.prPrimop primop);  say ", ";
309              printLty lty;  say ", ";
310              printTycList tycs;  say ") ";
311              printValList values;
312              newline();  dent();  pLexp body)
313    
314      and printFundec (fkind, lvar, lvar_lty_list, body) =      and printFundec (fkind, lvar, lvar_lty_list, body) =
315          (*  <lvar> : (<fkind>) <lty> =          (*  <lvar> : (<fkind>) <lty> =
316           *    FN([v1 : lty1,           *    FN([v1 : lty1,
# Line 317  Line 332 
332                     app (fn (lvar,lty) =>                     app (fn (lvar,lty) =>
333                          (say ","; newline(); dent();                          (say ","; newline(); dent();
334                           printVar lvar; say " : "; printLty lty)) L));                           printVar lvar; say " : "; printLty lty)) L));
335                print "],"; newline();                say "],"; newline();
336                undent 2;  dent();                undent 2;  dent();
337                pLexp body;                pLexp body; say ")";
338                undent 4; say ")")                undent 4)
339    
340      and printCase (con, lexp) =      and printCase (con, lexp) =
341          (printCon con;          (printCon con;
# Line 331  Line 346 
346    
347      fun printLexp lexp = pLexp lexp before (newline(); newline())      fun printLexp lexp = pLexp lexp before (newline(); newline())
348    
349        fun printProg prog = (printFundec prog; newline())
350    
351    
352  end (* structure PPFlint *)  end (* structure PPFlint *)
353    

Legend:
Removed from v.46  
changed lines
  Added in v.47

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