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/primop-branch-3/compiler/Elaborator/print/ppmod.sml
ViewVC logotype

Diff of /sml/branches/primop-branch-3/compiler/Elaborator/print/ppmod.sml

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

sml/trunk/src/compiler/Elaborator/print/ppmod.sml revision 1344, Wed Aug 13 18:04:08 2003 UTC sml/branches/primop-branch-3/compiler/Elaborator/print/ppmod.sml revision 3229, Sun Sep 21 23:03:38 2008 UTC
# Line 6  Line 6 
6    
7  signature PPMOD =  signature PPMOD =
8  sig  sig
9    val ppSignature: PrettyPrint.stream    val ppSignature: PrettyPrintNew.stream
10          -> Modules.Signature * StaticEnv.staticEnv * int -> unit          -> Modules.Signature * StaticEnv.staticEnv * int -> unit
11    val ppStructure: PrettyPrint.stream    val ppStructure: PrettyPrintNew.stream
12          -> Modules.Structure * StaticEnv.staticEnv * int -> unit          -> Modules.Structure * StaticEnv.staticEnv * int -> unit
13    val ppOpen: PrettyPrint.stream    val ppOpen: PrettyPrintNew.stream
14          -> SymPath.path * Modules.Structure * StaticEnv.staticEnv * int -> unit          -> SymPath.path * Modules.Structure * StaticEnv.staticEnv * int -> unit
15    val ppStructureName : PrettyPrint.stream    val ppStructureName : PrettyPrintNew.stream
16          -> Modules.Structure * StaticEnv.staticEnv -> unit          -> Modules.Structure * StaticEnv.staticEnv -> unit
17    val ppFunctor : PrettyPrint.stream    val ppFunctor : PrettyPrintNew.stream
18          -> Modules.Functor * StaticEnv.staticEnv * int -> unit          -> Modules.Functor * StaticEnv.staticEnv * int -> unit
19    val ppFunsig : PrettyPrint.stream    val ppFunsig : PrettyPrintNew.stream
20          -> Modules.fctSig * StaticEnv.staticEnv * int -> unit          -> Modules.fctSig * StaticEnv.staticEnv * int -> unit
21    val ppBinding: PrettyPrint.stream    val ppBinding: PrettyPrintNew.stream
22          -> Symbol.symbol * Bindings.binding * StaticEnv.staticEnv * int          -> Symbol.symbol * Bindings.binding * StaticEnv.staticEnv * int
23               -> unit               -> unit
24    val ppEnv : PrettyPrint.stream    val ppEnv : PrettyPrintNew.stream
25                -> StaticEnv.staticEnv * StaticEnv.staticEnv * int *                -> StaticEnv.staticEnv * StaticEnv.staticEnv * int *
26                   Symbol.symbol list option                   Symbol.symbol list option
27                -> unit                -> unit
# Line 29  Line 29 
29    (* module internals *)    (* module internals *)
30    
31    val ppElements : (StaticEnv.staticEnv * int * Modules.entityEnv option)    val ppElements : (StaticEnv.staticEnv * int * Modules.entityEnv option)
32                     -> PrettyPrint.stream                     -> PrettyPrintNew.stream
33                     -> Modules.elements -> unit                     -> Modules.elements -> unit
34    
35    val ppEntity : PrettyPrint.stream    val ppEntity : PrettyPrintNew.stream
36                   -> Modules.entity * StaticEnv.staticEnv * int                   -> Modules.entity * StaticEnv.staticEnv * int
37                   -> unit                   -> unit
38    
39    val ppEntityEnv : PrettyPrint.stream    val ppEntityEnv : PrettyPrintNew.stream
40                      -> Modules.entityEnv * StaticEnv.staticEnv * int                      -> Modules.entityEnv * StaticEnv.staticEnv * int
41                      -> unit                      -> unit
42    
# Line 62  Line 62 
62        structure EE = EntityEnv        structure EE = EntityEnv
63        structure LU = Lookup        structure LU = Lookup
64    
65        structure PP = PrettyPrint        structure PP = PrettyPrintNew
66        open PrettyPrint PPUtil        structure PU = PPUtilNew
67          open PrettyPrintNew PPUtilNew
68    
69  in  in
70    
# Line 90  Line 91 
91                    let val strEnt = EE.lookStrEnt(entities,entVar)                    let val strEnt = EE.lookStrEnt(entities,entVar)
92                     in SE.bind(sym,B.STRbind(M.STR{sign=sign,rlzn=strEnt,                     in SE.bind(sym,B.STRbind(M.STR{sign=sign,rlzn=strEnt,
93                                                    access=A.nullAcc,                                                    access=A.nullAcc,
94                                                    info=II.Null}),                                                    prim=[]}),
95                                env)                                env)
96                    end                    end
97                 | M.CONspec{spec=dcon, ...} => SE.bind(sym,B.CONbind dcon,env)                 | M.CONspec{spec=dcon, ...} => SE.bind(sym,B.CONbind dcon,env)
# Line 102  Line 103 
103  fun sigToEnv(M.SIG {elements,...}) =  fun sigToEnv(M.SIG {elements,...}) =
104      let fun bindElem ((sym,spec), env) =      let fun bindElem ((sym,spec), env) =
105            (case spec            (case spec
106              of M.TYCspec{spec,...} => SE.bind(sym,B.TYCbind spec,env)              of M.TYCspec{info=M.RegTycSpec{spec,...},...} =>
107                    SE.bind(sym,B.TYCbind spec,env)
108                 | M.TYCspec{info=M.InfTycSpec{name,arity},...} =>
109                    let val tyc =
110                            T.GENtyc{stamp=Stamps.special "x", arity=arity,
111                                     eq=ref(T.UNDEF), kind=T.FORMAL, stub=NONE,
112                                     path=InvPath.extend(InvPath.empty,name)}
113                    in SE.bind(sym,B.TYCbind tyc,env)
114                    end
115               | M.STRspec{sign,slot,def,entVar=ev} =>               | M.STRspec{sign,slot,def,entVar=ev} =>
116                   SE.bind(sym,B.STRbind(M.STRSIG{sign=sign,entPath=[ev]}),env)                   SE.bind(sym,B.STRbind(M.STRSIG{sign=sign,entPath=[ev]}),env)
117               | M.CONspec{spec=dcon, ...} => SE.bind(sym,B.CONbind dcon,env)               | M.CONspec{spec=dcon, ...} => SE.bind(sym,B.CONbind dcon,env)
# Line 179  Line 188 
188    
189  fun ppVariable ppstrm  =  fun ppVariable ppstrm  =
190      let val {openHVBox, openHOVBox,closeBox,pps,...} = en_pp ppstrm      let val {openHVBox, openHOVBox,closeBox,pps,...} = en_pp ppstrm
191          fun ppV(V.VALvar{path,access,typ,info},env:StaticEnv.staticEnv) =          fun ppV(V.VALvar{path,access,typ,prim,btvs},env:StaticEnv.staticEnv) =
192                (openHVBox 0;                (openHVBox 0;
193                 pps (SP.toString path);                 pps (SP.toString path);
194                 if !internals then PPVal.ppAccess ppstrm access else ();                 if !internals then PPVal.ppAccess ppstrm access else ();
# Line 190  Line 199 
199                 ppSym ppstrm (name); pps " : "; ppType env ppstrm body;                 ppSym ppstrm (name); pps " : "; ppType env ppstrm body;
200                 pps " as ";                 pps " as ";
201                 ppSequence ppstrm                 ppSequence ppstrm
202                   {sep=C PrettyPrint.break{nsp=1,offset=0},                   {sep=C PrettyPrintNew.break{nsp=1,offset=0},
203                    pr=(fn ppstrm => fn{variant,...} =>ppV(variant,env)),                    pr=(fn ppstrm => fn{variant,...} =>ppV(variant,env)),
204                    style=CONSISTENT}                    style=CONSISTENT}
205                   optl;                   optl;
# Line 219  Line 228 
228      end      end
229    
230  fun ppStructure ppstrm (str,env,depth) =  fun ppStructure ppstrm (str,env,depth) =
231      let val {openHVBox, openHOVBox,closeBox,pps,break,newline} = en_pp ppstrm      let val {openHVBox, openHOVBox,closeBox,pps,ppi,break,newline} = en_pp ppstrm
232       in case str       in case str
233            of M.STR { sign, rlzn as { entities, ... }, ... } =>            of M.STR { sign, rlzn as { entities, ... }, prim, ... } =>
234               (if !internals               (if !internals
235                then (openHVBox 2;                then (openHVBox 2;
236                         pps "STR";                         pps "STR";
# Line 234  Line 243 
243                          pps "rlzn:";                          pps "rlzn:";
244                          break {nsp=1,offset=2};                          break {nsp=1,offset=2};
245                          ppStrEntity ppstrm (rlzn,env,depth-1);                          ppStrEntity ppstrm (rlzn,env,depth-1);
246                            newline();
247                            pps "prim:";
248                            break {nsp=1,offset=2};
249                            (* GK: This should be cleaned up soon so as to use a
250                               ppStrInfo that is an actual pretty printer conforming
251                               to the pattern of the other pretty printers.
252                            PrimOpId.ppStrInfo prim; *)
253                            PPPrim.ppStrPrimInfo ppstrm prim;
254                         closeBox();                         closeBox();
255                        closeBox())                        closeBox())
256                  else case sign                  else case sign
# Line 299  Line 316 
316                     closeBox ppstrm;                     closeBox ppstrm;
317                    closeBox ppstrm)                    closeBox ppstrm)
318    
319                | M.TYCspec{spec,entVar,repl,scope} =>                | M.TYCspec{entVar,info} =>
320                   (if first then () else newline ppstrm;                   (if first then () else newline ppstrm;
321                    openHVBox ppstrm (PP.Rel 0);                    case info
322                        of M.RegTycSpec{spec,repl,scope} =>
323                           (openHVBox ppstrm (PP.Rel 0);
324                     case entityEnvOp                     case entityEnvOp
325                       of NONE =>                       of NONE =>
326                           if repl then                           if repl then
# Line 324  Line 343 
343                           pps ppstrm (Int.toString scope))                           pps ppstrm (Int.toString scope))
344                     else ();                     else ();
345                    closeBox ppstrm)                    closeBox ppstrm)
346                         | M.InfTycSpec{name,arity} =>
347                           (openHVBox ppstrm (PP.Rel 0);
348                             case entityEnvOp
349                               of NONE =>
350                                   (pps ppstrm "type";
351                                    ppFormals ppstrm arity;
352                                    pps ppstrm " ";
353                                    ppSym ppstrm name)
354                                | SOME eenv =>
355                                   (case EE.look(eenv,entVar)
356                                      of M.TYCent tyc =>
357                                           ppTycBind ppstrm (tyc,env)
358                                       | M.ERRORent => pps ppstrm "<ERRORent>"
359                                       | _ => bug "ppElements:TYCent");
360                             if !internals
361                             then (newline ppstrm;
362                                   pps ppstrm "entVar: ";
363                                   pps ppstrm (EntPath.entVarToString entVar))
364                             else ();
365                            closeBox ppstrm))
366    
367                | M.VALspec{spec=typ,...} =>                | M.VALspec{spec=typ,...} =>
368                   (if first then () else newline ppstrm;                   (if first then () else newline ppstrm;
# Line 341  Line 380 
380                   if !internals                   if !internals
381                   then (if first then () else newline ppstrm;                   then (if first then () else newline ppstrm;
382                         ppConBinding ppstrm (dcon,env))                         ppConBinding ppstrm (dcon,env))
383                   else () (* ordinary data constructor, don't print *)                   else () (* don't pring ordinary data constructor,
384                              * because it was printed with its datatype *)
385    
386       in openHVBox ppstrm (PP.Rel 0);       in openHVBox ppstrm (PP.Rel 0);
387          case elements          case elements
# Line 351  Line 391 
391      end      end
392    
393  and ppSignature0 ppstrm (sign,env,depth,entityEnvOp) =  and ppSignature0 ppstrm (sign,env,depth,entityEnvOp) =
394      let val {openHVBox, openHOVBox,closeBox,pps,break,newline} = en_pp ppstrm      let val {openHVBox, openHOVBox,closeBox,pps,ppi,break,newline} =
395                en_pp ppstrm
396          val env = SE.atop(case entityEnvOp          val env = SE.atop(case entityEnvOp
397                              of NONE => sigToEnv sign                              of NONE => sigToEnv sign
398                               | SOME entEnv => strToEnv(sign,entEnv),                               | SOME entEnv => strToEnv(sign,entEnv),
# Line 371  Line 412 
412                         closeBox()))                         closeBox()))
413                    constraints;                    constraints;
414                  closeBox ())                  closeBox ())
415          val somePrint = ref false          val somePrint = ref false (* i.e., signature is not empty sig end *)
416       in if depth <= 0       in if depth <= 0
417          then pps "<sig>"          then pps "<sig>"
418          else          else
419          case sign          case sign
420            of M.SIG {stamp,name,elements,typsharing,strsharing,...} =>            of M.SIG {stamp,name,elements,typsharing,strsharing,...} =>
421                 let
422                     (* Filter out ordinary dcon that do not print in ppElements
423                        for element printing so that we do not print the spurious
424                        newline. We still use the unfiltered elements
425                        for determining whether the sig ... end should be
426                        multiline even with just one datatype. *)
427                    val elems' =
428                        List.filter
429                        (fn (_,M.CONspec{spec=T.DATACON{rep=A.EXN _,...},...})
430                                => true
431                          | (_,M.CONspec{spec=dcon,...}) => false
432                          | _ => true)
433                        elements
434                 in
435               if !internals then               if !internals then
436                 (openHVBox 0;                 (openHVBox 0;
437                   pps "SIG:";                   pps "SIG:";
# Line 408  Line 463 
463                else (* not !internals *)                else (* not !internals *)
464                  (openHVBox 0;                  (openHVBox 0;
465                    pps "sig";                    pps "sig";
466                    break{nsp=1,offset=2};                    (case elements
467                           of nil => pps " "
468                            | [(_,M.STRspec _)] => nl_indent ppstrm 2
469                            | [_] => pps " "
470                            | _ => nl_indent ppstrm 2);
471                    openHVBox 0;                    openHVBox 0;
472                     case elements                     case elements
473                       of nil => ()                       of nil => ()
474                        | _ => (ppElements (env,depth,entityEnvOp) ppstrm elements;                        | _ => (ppElements (env,depth,entityEnvOp) ppstrm elems';
475                                somePrint := true);                                somePrint := true);
476                     case strsharing                     case strsharing
477                       of nil => ()                       of nil => ()
# Line 425  Line 484 
484                                ppConstraints("type ",typsharing);                                ppConstraints("type ",typsharing);
485                                somePrint := true);                                somePrint := true);
486                    closeBox();                    closeBox();
487                    if !somePrint then break{nsp=1,offset=0} else ();                    (case elements
488                        of nil => ()
489                         | [(_,M.STRspec _)] => newline()
490                         | [_] => pps " "
491                         | _ => newline());
492                    pps "end";                    pps "end";
493                   closeBox())                   closeBox())
494                 end
495             | M.ERRORsig => pps "<error sig>"             | M.ERRORsig => pps "<error sig>"
496      end      end
497    
498  and ppFunsig ppstrm (sign,env,depth) =  and ppFunsig ppstrm (sign,env,depth) =
499      let val {openHVBox, openHOVBox,closeBox,pps,break,newline} = en_pp ppstrm      let val {openHVBox, openHOVBox,closeBox,pps,ppi,break,newline} =
500                en_pp ppstrm
501          fun trueBodySig (orig as M.SIG { elements =          fun trueBodySig (orig as M.SIG { elements =
502                                           [(sym, M.STRspec { sign, ... })],                                           [(sym, M.STRspec { sign, ... })],
503                                           ... }) =                                           ... }) =
# Line 476  Line 541 
541                  | M.ERRORfsig => pps "<error fsig>"                  | M.ERRORfsig => pps "<error fsig>"
542      end      end
543    
   
544  and ppStrEntity ppstrm (e,env,depth) =  and ppStrEntity ppstrm (e,env,depth) =
545      let val {stamp,entities,properties,rpath,stub} = e      let val {stamp,entities,properties,rpath,stub} = e
546          val {openHVBox, openHOVBox,closeBox,pps,break,newline} = en_pp ppstrm          val {openHVBox, openHOVBox,closeBox,pps,ppi,break,newline} =
547                en_pp ppstrm
548       in if depth <= 1       in if depth <= 1
549          then pps "<structure entity>"          then pps "<structure entity>"
550          else (openHVBox 0;          else (openHVBox 0;
# Line 504  Line 569 
569      end      end
570    
571  and ppFctEntity ppstrm (e, env, depth) =  and ppFctEntity ppstrm (e, env, depth) =
572      let val {stamp,closure,properties,tycpath,rpath,stub} = e      let val {stamp,paramRlzn,bodyRlzn,closure,properties,rpath,stub} = e
573          val {openHVBox,openHOVBox,closeBox,pps,break,newline} = en_pp ppstrm          val {openHVBox,openHOVBox,closeBox,pps,ppi,break,newline} = en_pp ppstrm
574      in if depth <= 1      in if depth <= 1
575          then pps "<functor entity>"          then pps "<functor entity>"
576          else (openHVBox 0;          else (openHVBox 0;
# Line 518  Line 583 
583                  pps "stamp: ";                  pps "stamp: ";
584                  pps (Stamps.toShortString stamp);                  pps (Stamps.toShortString stamp);
585                  newline();                  newline();
586                    pps "paramRlzn: ";
587                    break{nsp=1,offset=2};
588                    ppStrEntity ppstrm (paramRlzn,env,depth-1);
589                    newline();
590                    pps "bodyRlzn: ";
591                    break{nsp=1,offset=2};
592                    ppStrEntity ppstrm (bodyRlzn,env,depth-1);
593                    newline();
594                  pps "closure:";                  pps "closure:";
595                  break{nsp=1,offset=2};                  break{nsp=1,offset=2};
596                  ppClosure ppstrm (closure,depth-1);                  ppClosure ppstrm (closure,depth-1);
# Line 525  Line 598 
598                  pps "lambdaty:";                  pps "lambdaty:";
599                  break{nsp=1,offset=2};                  break{nsp=1,offset=2};
600                  ppLty ppstrm ( (* ModulePropLists.fctEntityLty e,depth-1 *) );                  ppLty ppstrm ( (* ModulePropLists.fctEntityLty e,depth-1 *) );
601            (*      newline();
602                  pps "tycpath:";                  pps "tycpath:";
603                  break{nsp=1,offset=2};                  break{nsp=1,offset=2};
604                  pps "--printing of tycpath not implemented yet--";                  (case tycpath
605                      of SOME(tp) => PPType.ppTycpath env ppstrm tp
606                       | NONE => pps "no tycpath"); *)
607                 closeBox ();                 closeBox ();
608                closeBox ())                closeBox ())
609      end      end
610    
611  and ppFunctor ppstrm =  and ppFunctor ppstrm =
612      let val {openHVBox, openHOVBox,closeBox,pps,break,newline} = en_pp ppstrm      let val {openHVBox, openHOVBox,closeBox,pps,ppi,break,newline} = en_pp ppstrm
613          fun ppF (M.FCT { sign, rlzn, ... }, env, depth) =          fun ppF (M.FCT { sign, rlzn, ... }, env, depth) =
614                  if depth <= 1                  if depth <= 1
615                  then pps "<functor>"                  then pps "<functor>"
# Line 551  Line 627 
627      end      end
628    
629  and ppTycBind ppstrm (tyc,env) =  and ppTycBind ppstrm (tyc,env) =
630      let val {openHVBox, openHOVBox,closeBox,pps,break,newline} = en_pp ppstrm      let val {openHVBox, openHOVBox,closeBox,pps,ppi,break,newline} = en_pp ppstrm
631          fun visibleDcons(tyc,dcons) =          fun visibleDcons(tyc,dcons) =
632              let fun checkCON(V.CON c) = c              let fun checkCON(V.CON c) = c
633                    | checkCON _ = raise SE.Unbound                    | checkCON _ = raise SE.Unbound
# Line 634  Line 710 
710                                 (break{nsp=1,offset=2};                                 (break{nsp=1,offset=2};
711                                  openHVBox 0;                                  openHVBox 0;
712                                   pps "= "; ppDcon first;                                   pps "= "; ppDcon first;
713                                   app (fn d => (break{nsp=1,offset=0}; pps "| "; ppDcon d))                                   app (fn d => (break{nsp=1,offset=0};
714                                                   pps "| "; ppDcon d))
715                                       rest;                                       rest;
716                                   if incomplete                                   if incomplete
717                                       then (break{nsp=1,offset=0}; pps "... ")                                       then (break{nsp=1,offset=0}; pps "... ")
# Line 661  Line 738 
738                   break{nsp=1,offset=0};                   break{nsp=1,offset=0};
739                   ppType env ppstrm body;                   ppType env ppstrm body;
740                   closeBox ())                   closeBox ())
741                  | T.ERRORtyc =>
742                    (pps "ERRORtyc")
743                  | T.PATHtyc _ =>
744                    (pps "PATHtyc:";
745                     ppTycon env ppstrm tyc)
746                | tycon =>                | tycon =>
747                  (pps "strange tycon: ";                  (pps "strange tycon: ";
748                   ppTycon env ppstrm tycon)                   ppTycon env ppstrm tycon)
749      end (* ppTycBind *)      end (* ppTycBind *)
750    
751  and ppReplBind ppstrm  and ppReplBind ppstrm =
752       (T.DEFtyc{tyfun=T.TYFUN{body=T.CONty(rightTyc,_),...},path,...},env) =      let
753      let val {openHVBox, openHOVBox,closeBox,pps,break,newline} = en_pp ppstrm          val {openHVBox, openHOVBox,closeBox,pps,ppi,break,newline} =
754       in openHOVBox 2;                en_pp ppstrm
755        in
756            fn (T.DEFtyc{tyfun=T.TYFUN{body=T.CONty(rightTyc,_),...},path,...},
757                env) =>
758               (* [GK 5/4/07] Does this case ever occur? All datatype
759                  replication tycs are GENtycs after elaboration *)
760               (openHOVBox 2;
761          pps "datatype"; break{nsp=1,offset=0};          pps "datatype"; break{nsp=1,offset=0};
762          ppSym ppstrm (IP.last path);          ppSym ppstrm (IP.last path);
763          pps " ="; break{nsp=1,offset=0};          pps " ="; break{nsp=1,offset=0};
764          pps "datatype"; break{nsp=1,offset=0};          pps "datatype"; break{nsp=1,offset=0};
765          ppTycon env ppstrm rightTyc;          ppTycon env ppstrm rightTyc;
766          closeBox ()              closeBox ())
767      end           | (tyc as T.GENtyc{stamp, arity, eq, kind, path, stub}, env) =>
768    | ppReplBind _ _ = ErrorMsg.impossible "ppReplBind"             (openHOVBox 2;
769                pps "datatype"; break{nsp=1,offset=0};
770                ppSym ppstrm (IP.last path);
771                pps " ="; break{nsp=1,offset=0};
772                ppTycBind ppstrm (tyc, env);
773                closeBox())
774             | (T.PATHtyc _, _) => ErrorMsg.impossible "<replbind:PATHtyc>"
775             | (T.RECtyc _, _) => ErrorMsg.impossible "<replbind:RECtyc>"
776             | (T.FREEtyc _, _) => ErrorMsg.impossible "<replbind:FREEtyc>"
777             | _ => ErrorMsg.impossible "ppReplBind"
778        end (* fun ppReplBind *)
779    
780  and ppEntity ppstrm (entity,env,depth) =  and ppEntity ppstrm (entity,env,depth) =
781      case entity      case entity
# Line 689  Line 787 
787  and ppEntityEnv ppstrm (entEnv,env,depth) =  and ppEntityEnv ppstrm (entEnv,env,depth) =
788      if depth <= 1      if depth <= 1
789      then pps ppstrm "<entityEnv>"      then pps ppstrm "<entityEnv>"
790      else (ppvseq ppstrm 2 ""      else (ppvseq ppstrm 0 ""
791                (fn ppstrm => fn (entVar,entity) =>                (fn ppstrm => fn (entVar,entity) =>
792                  let val {openHVBox,openHOVBox,closeBox,pps,break,newline} =                  let val {openHVBox,openHOVBox,closeBox,pps,ppi,break,newline} =
793                           en_pp ppstrm                           en_pp ppstrm
794                   in openHVBox 2;                   in openHVBox 2;
795                       pps (EntPath.entVarToString entVar);                       pps (EntPath.entVarToString entVar);
# Line 794  Line 892 
892               pps ppstrm "bod:"; ppStrExp ppstrm (body, depth-1);               pps ppstrm "bod:"; ppStrExp ppstrm (body, depth-1);
893              closeBox ppstrm;              closeBox ppstrm;
894             closeBox ppstrm)             closeBox ppstrm)
895         | M.LAMBDA {param, body} =>         | M.LAMBDA {param, paramRlzn, body} =>
896            (openHVBox ppstrm (PP.Rel 0);            (openHVBox ppstrm (PP.Rel 0);
897              pps ppstrm "FE.L:"; break ppstrm {nsp=1,offset=1};              pps ppstrm "FE.L:"; break ppstrm {nsp=1,offset=1};
898              openHVBox ppstrm (PP.Rel 0);              openHVBox ppstrm (PP.Rel 0);
899               pps ppstrm "par:"; ppEntVar ppstrm param;               pps ppstrm "par:"; ppEntVar ppstrm param;
900               break ppstrm {nsp=1,offset=0};               break ppstrm {nsp=1,offset=0};
901                 pps ppstrm "parents:";
902                 ppStrEntity ppstrm (paramRlzn, SE.empty, depth-1);
903                 break ppstrm {nsp=1,offset=0};
904               pps ppstrm "bod:"; ppStrExp ppstrm (body, depth-1);               pps ppstrm "bod:"; ppStrExp ppstrm (body, depth-1);
905              closeBox ppstrm;              closeBox ppstrm;
906             closeBox ppstrm)             closeBox ppstrm)
# Line 850  Line 951 
951         | B.CONbind con => ppConBinding ppstrm (con,env)         | B.CONbind con => ppConBinding ppstrm (con,env)
952         | B.TYCbind tycon => ppTycBind ppstrm (tycon,env)         | B.TYCbind tycon => ppTycBind ppstrm (tycon,env)
953         | B.SIGbind sign =>         | B.SIGbind sign =>
954            let val {openHVBox,openHOVBox,closeBox,pps,break,...} = en_pp ppstrm            let val {openHVBox,openHOVBox,closeBox,pps,ppi,break,...} = en_pp ppstrm
955             in openHVBox 0;             in openHVBox 0;
956                 pps "signature "; ppSym ppstrm name; pps " =";                 pps "signature "; ppSym ppstrm name; pps " =";
957                 break{nsp=1,offset=2};                 break{nsp=1,offset=2};
# Line 865  Line 966 
966                closeBox()                closeBox()
967            end            end
968         | B.STRbind str =>         | B.STRbind str =>
969            let val {openHVBox, openHOVBox,closeBox,pps,break,...} = en_pp ppstrm            let val {openHVBox, openHOVBox,closeBox,pps,ppi,break,...} = en_pp ppstrm
970             in openHVBox 0;             in openHVBox 0;
971                 pps "structure "; ppSym ppstrm name; pps " :";                 pps "structure "; ppSym ppstrm name; pps " :";
972                 break{nsp=1,offset=2};                 break{nsp=1,offset=2};
# Line 907  Line 1008 
1008      end      end
1009    
1010  fun ppOpen ppstrm (path,str,env,depth) =  fun ppOpen ppstrm (path,str,env,depth) =
1011      let val {openHVBox,openHOVBox,closeBox,pps,break,newline} = en_pp ppstrm      let val {openHVBox,openHOVBox,closeBox,pps,ppi,break,newline} = en_pp ppstrm
1012       in openHVBox 0;       in openHVBox 0;
1013           openHVBox 2;           openHVBox 2;
1014            pps "opening ";            pps "opening ";

Legend:
Removed from v.1344  
changed lines
  Added in v.3229

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