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

revision 2571, Sun May 20 15:12:54 2007 UTC revision 3299, Fri Apr 24 13:58:04 2009 UTC
# Line 188  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,prim},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 246  Line 246 
246                          newline();                          newline();
247                          pps "prim:";                          pps "prim:";
248                          break {nsp=1,offset=2};                          break {nsp=1,offset=2};
                         (* GK: This should be cleaned up soon so as to use a  
                            ppStrInfo that is an actual pretty printer conforming  
                            to the pattern of the other pretty printers.  
                         PrimOpId.ppStrInfo prim; *)  
249                          PPPrim.ppStrPrimInfo ppstrm prim;                          PPPrim.ppStrPrimInfo ppstrm prim;
250                         closeBox();                         closeBox();
251                        closeBox())                        closeBox())
# Line 348  Line 344 
344                           case entityEnvOp                           case entityEnvOp
345                             of NONE =>                             of NONE =>
346                                 (pps ppstrm "type";                                 (pps ppstrm "type";
347                                  break ppstrm {nsp=1,offset=0};                                  ppFormals ppstrm arity;
348                                  ppFormals ppstrm arity; pps ppstrm " ";                                  pps ppstrm " ";
349                                  ppSym ppstrm name)                                  ppSym ppstrm name)
350                              | SOME eenv =>                              | SOME eenv =>
351                                 (case EE.look(eenv,entVar)                                 (case EE.look(eenv,entVar)
# Line 542  Line 538 
538      end      end
539    
540  and ppStrEntity ppstrm (e,env,depth) =  and ppStrEntity ppstrm (e,env,depth) =
541      let val {stamp,entities,properties,rpath,stub} = e      let val {stamp,entities,rpath,stub,properties} = e
542          val {openHVBox, openHOVBox,closeBox,pps,ppi,break,newline} =          val {openHVBox, openHOVBox,closeBox,pps,ppi,break,newline} =
543              en_pp ppstrm              en_pp ppstrm
544       in if depth <= 1       in if depth <= 1
# Line 560  Line 556 
556                  pps "entities:";                  pps "entities:";
557                  nl_indent ppstrm 2;                  nl_indent ppstrm 2;
558                  ppEntityEnv ppstrm (entities,env,depth-1);                  ppEntityEnv ppstrm (entities,env,depth-1);
                 newline();  
                 pps "lambdaty:";  
                 nl_indent ppstrm 2;  
                 ppLty ppstrm ( (* ModulePropLists.strEntityLty e,depth-1 *));  
559                 closeBox ();                 closeBox ();
560                closeBox ())                closeBox ())
561      end      end
562    
563  and ppFctEntity ppstrm (e, env, depth) =  and ppFctEntity ppstrm (e, env, depth) =
564      let val {stamp,closure,properties,tycpath,rpath,stub} = e      let val {stamp,paramRlzn,closure,rpath,stub,properties} = e
565          val {openHVBox,openHOVBox,closeBox,pps,ppi,break,newline} = en_pp ppstrm          val {openHVBox,openHOVBox,closeBox,pps,ppi,break,newline} = en_pp ppstrm
566      in if depth <= 1      in if depth <= 1
567          then pps "<functor entity>"          then pps "<functor entity>"
# Line 583  Line 575 
575                  pps "stamp: ";                  pps "stamp: ";
576                  pps (Stamps.toShortString stamp);                  pps (Stamps.toShortString stamp);
577                  newline();                  newline();
578                    pps "paramRlzn: ";
579                    break{nsp=1,offset=2};
580                    ppStrEntity ppstrm (paramRlzn,env,depth-1);
581                    newline();
582                  pps "closure:";                  pps "closure:";
583                  break{nsp=1,offset=2};                  break{nsp=1,offset=2};
584                  ppClosure ppstrm (closure,depth-1);                  ppClosure ppstrm (closure,depth-1);
585                  newline();                  newline();
                 pps "lambdaty:";  
                 break{nsp=1,offset=2};  
                 ppLty ppstrm ( (* ModulePropLists.fctEntityLty e,depth-1 *) );  
                 pps "tycpath:";  
                 break{nsp=1,offset=2};  
                 pps "--printing of tycpath not implemented yet--";  
586                 closeBox ();                 closeBox ();
587                closeBox ())                closeBox ())
588      end      end
# Line 776  Line 766 
766  and ppEntityEnv ppstrm (entEnv,env,depth) =  and ppEntityEnv ppstrm (entEnv,env,depth) =
767      if depth <= 1      if depth <= 1
768      then pps ppstrm "<entityEnv>"      then pps ppstrm "<entityEnv>"
769      else (ppvseq ppstrm 2 ""      else (ppvseq ppstrm 0 ""
770                (fn ppstrm => fn (entVar,entity) =>                (fn ppstrm => fn (entVar,entity) =>
771                  let val {openHVBox,openHOVBox,closeBox,pps,ppi,break,newline} =                  let val {openHVBox,openHOVBox,closeBox,pps,ppi,break,newline} =
772                           en_pp ppstrm                           en_pp ppstrm
# Line 872  Line 862 
862            (pps ppstrm "FE.V:"; ppEntPath ppstrm ep)            (pps ppstrm "FE.V:"; ppEntPath ppstrm ep)
863         | M.CONSTfct { rpath, ... } =>         | M.CONSTfct { rpath, ... } =>
864            (pps ppstrm "FE.C:"; ppInvPath ppstrm rpath)            (pps ppstrm "FE.C:"; ppInvPath ppstrm rpath)
865         | M.LAMBDA_TP {param, body, ...} =>         | M.LAMBDA {param, paramRlzn, body} =>
           (openHVBox ppstrm (PP.Rel 0);  
             pps ppstrm "FE.LP:"; break ppstrm {nsp=1,offset=1};  
             openHVBox ppstrm (PP.Rel 0);  
              pps ppstrm "par:"; ppEntVar ppstrm param;  
              break ppstrm {nsp=1,offset=0};  
              pps ppstrm "bod:"; ppStrExp ppstrm (body, depth-1);  
             closeBox ppstrm;  
            closeBox ppstrm)  
        | M.LAMBDA {param, body} =>  
866            (openHVBox ppstrm (PP.Rel 0);            (openHVBox ppstrm (PP.Rel 0);
867              pps ppstrm "FE.L:"; break ppstrm {nsp=1,offset=1};              pps ppstrm "FE.L:"; break ppstrm {nsp=1,offset=1};
868              openHVBox ppstrm (PP.Rel 0);              openHVBox ppstrm (PP.Rel 0);
869               pps ppstrm "par:"; ppEntVar ppstrm param;               pps ppstrm "par:"; ppEntVar ppstrm param;
870               break ppstrm {nsp=1,offset=0};               break ppstrm {nsp=1,offset=0};
871                 pps ppstrm "parents:";
872                 ppStrEntity ppstrm (paramRlzn, SE.empty, depth-1);
873                 break ppstrm {nsp=1,offset=0};
874               pps ppstrm "bod:"; ppStrExp ppstrm (body, depth-1);               pps ppstrm "bod:"; ppStrExp ppstrm (body, depth-1);
875              closeBox ppstrm;              closeBox ppstrm;
876             closeBox ppstrm)             closeBox ppstrm)

Legend:
Removed from v.2571  
changed lines
  Added in v.3299

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