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 3287, Wed Apr 8 06:15:05 2009 UTC revision 3322, Wed May 6 22:47:35 2009 UTC
# Line 40  Line 40 
40                      -> Modules.entityEnv * StaticEnv.staticEnv * int                      -> Modules.entityEnv * StaticEnv.staticEnv * int
41                      -> unit                      -> unit
42    
43      val ppEPC : PrettyPrintNew.stream
44                  -> EntPathContext.context * int
45                  -> unit
46    
47  end (* signature PPMOD *)  end (* signature PPMOD *)
48    
49    
# Line 132  Line 136 
136                   in (TU.equalTycon                   in (TU.equalTycon
137                        (LU.lookTyc                        (LU.lookTyc
138                           (env,                           (env,
139                            SP.SPATH[IP.last(TU.tycPath tyc)],                            SP.SPATH[IP.last(TU.tycPath tyc) handle InvPath.InvPath => bug "ppmod:is_ppable_Consbinding"],
140                            fn _ => raise Hidden),                            fn _ => raise Hidden),
141                         tyc)                         tyc)
142                         handle Hidden => false)                         handle Hidden => false)
# Line 161  Line 165 
165         pr=ppEntVar}         pr=ppEntVar}
166  *)  *)
167    
168    local
169       open EntPathContext
170    in
171    fun ppEPC ppstrm (context, d) =
172        (case context
173          of EMPTY => pps ppstrm "[<empty>]"
174           | LAYER{locals, context, outer} =>
175               (pps ppstrm "[LAYER ";
176                ppEntPath ppstrm context;
177                ppEPC ppstrm (outer, d);
178                pps ppstrm "]"))
179    end
180    
181  fun ppTycExp ppstrm (tycExp,depth) =  fun ppTycExp ppstrm (tycExp,depth) =
182      if depth <= 0 then pps ppstrm "<tycExp>" else      if depth <= 0 then pps ppstrm "<tycExp>" else
183      case tycExp      case tycExp
# Line 538  Line 555 
555      end      end
556    
557  and ppStrEntity ppstrm (e,env,depth) =  and ppStrEntity ppstrm (e,env,depth) =
558      let val {stamp,entities,properties,rpath,stub} = e      let val {stamp,entities,rpath,stub,properties} = e
559          val {openHVBox, openHOVBox,closeBox,pps,ppi,break,newline} =          val {openHVBox, openHOVBox,closeBox,pps,ppi,break,newline} =
560              en_pp ppstrm              en_pp ppstrm
561       in if depth <= 1       in if depth <= 1
# Line 556  Line 573 
573                  pps "entities:";                  pps "entities:";
574                  nl_indent ppstrm 2;                  nl_indent ppstrm 2;
575                  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 *) );  
576                 closeBox ();                 closeBox ();
577                closeBox ())                closeBox ())
578      end      end
579    
580  and ppFctEntity ppstrm (e, env, depth) =  and ppFctEntity ppstrm (e, env, depth) =
581      let val {stamp,paramRlzn,bodyRlzn (*DELETE*),closure,properties,rpath,stub} = e      let val {stamp,paramRlzn,closure,rpath,stub,properties} = e
582          val {openHVBox,openHOVBox,closeBox,pps,ppi,break,newline} = en_pp ppstrm          val {openHVBox,openHOVBox,closeBox,pps,ppi,break,newline} = en_pp ppstrm
583      in if depth <= 1      in if depth <= 1
584          then pps "<functor entity>"          then pps "<functor entity>"
# Line 583  Line 596 
596                  break{nsp=1,offset=2};                  break{nsp=1,offset=2};
597                  ppStrEntity ppstrm (paramRlzn,env,depth-1);                  ppStrEntity ppstrm (paramRlzn,env,depth-1);
598                  newline();                  newline();
 (* bodyRlzn field to be deleted  
                 pps "bodyRlzn: ";  
                 break{nsp=1,offset=2};  
                 ppStrEntity ppstrm (bodyRlzn,env,depth-1);  
                 newline();  
 *)  
599                  pps "closure:";                  pps "closure:";
600                  break{nsp=1,offset=2};                  break{nsp=1,offset=2};
601                  ppClosure ppstrm (closure,depth-1);                  ppClosure ppstrm (closure,depth-1);
602                  newline();                  newline();
                 pps "lambdaty:";  
                 break{nsp=1,offset=2};  
                 ppLty ppstrm ( (* ModulePropLists.fctEntityLty e,depth-1 *) );  
         (*      newline();  
                 pps "tycpath:";  
                 break{nsp=1,offset=2};  
                 (case tycpath  
                   of SOME(tp) => PPType.ppTycpath env ppstrm tp  
                    | NONE => pps "no tycpath"); *)  
603                 closeBox ();                 closeBox ();
604                closeBox ())                closeBox ())
605      end      end
# Line 689  Line 687 
687                        pps "type";                        pps "type";
688                        ppFormals ppstrm arity;                        ppFormals ppstrm arity;
689                        pps " ";                        pps " ";
690                        ppSym ppstrm (IP.last path);                        ppSym ppstrm (IP.last path handle InvPath.InvPath => bug "ppmod:ppTycBind");
691                        closeBox())                        closeBox())
692                     | (_, T.DATATYPE{index,family={members,...},...}) =>                     | (_, T.DATATYPE{index,family={members,...},...}) =>
693                       (* ordinary datatype *)                       (* ordinary datatype *)
# Line 701  Line 699 
699                           pps "datatype";                           pps "datatype";
700                           ppFormals ppstrm arity;                           ppFormals ppstrm arity;
701                           pps " ";                           pps " ";
702                           ppSym ppstrm (IP.last path);                           ppSym ppstrm (IP.last path handle InvPath.InvPath => bug "ppmod:ppTycBind 2");
703                           case visdcons                           case visdcons
704                             of nil => pps " = ..."                             of nil => pps " = ..."
705                              | first :: rest =>                              | first :: rest =>
# Line 724  Line 722 
722                        else pps "type";                        else pps "type";
723                        ppFormals ppstrm arity;                        ppFormals ppstrm arity;
724                        pps " ";                        pps " ";
725                        ppSym ppstrm (IP.last path);                        ppSym ppstrm (IP.last path handle IP.InvPath => bug "ppmod:ppTycBind 3");
726                        closeBox()))                        closeBox()))
727                | T.DEFtyc{path,tyfun=T.TYFUN{arity,body},...} =>                | T.DEFtyc{path,tyfun=T.TYFUN{arity,body},...} =>
728                  (openHOVBox 2;                  (openHOVBox 2;
729                   pps "type";                   pps "type";
730                   ppFormals ppstrm arity;                   ppFormals ppstrm arity;
731                   break{nsp=1,offset=0};                   break{nsp=1,offset=0};
732                   ppSym ppstrm (InvPath.last path);                   ppSym ppstrm (InvPath.last path handle InvPath.InvPath => bug "ppmod:ppTycBind 2");
733                   pps " =";                   pps " =";
734                   break{nsp=1,offset=0};                   break{nsp=1,offset=0};
735                   ppType env ppstrm body;                   ppType env ppstrm body;
# Line 757  Line 755 
755                replication tycs are GENtycs after elaboration *)                replication tycs are GENtycs after elaboration *)
756             (openHOVBox 2;             (openHOVBox 2;
757              pps "datatype"; break{nsp=1,offset=0};              pps "datatype"; break{nsp=1,offset=0};
758              ppSym ppstrm (IP.last path);              ppSym ppstrm (IP.last path handle InvPath.InvPath => bug "ppmod:ppReplBind");
759              pps " ="; break{nsp=1,offset=0};              pps " ="; break{nsp=1,offset=0};
760              pps "datatype"; break{nsp=1,offset=0};              pps "datatype"; break{nsp=1,offset=0};
761              ppTycon env ppstrm rightTyc;              ppTycon env ppstrm rightTyc;
# Line 765  Line 763 
763           | (tyc as T.GENtyc{stamp, arity, eq, kind, path, stub}, env) =>           | (tyc as T.GENtyc{stamp, arity, eq, kind, path, stub}, env) =>
764             (openHOVBox 2;             (openHOVBox 2;
765              pps "datatype"; break{nsp=1,offset=0};              pps "datatype"; break{nsp=1,offset=0};
766              ppSym ppstrm (IP.last path);              ppSym ppstrm (IP.last path handle InvPath.InvPath => bug "ppmod:ppReplBind 2");
767              pps " ="; break{nsp=1,offset=0};              pps " ="; break{nsp=1,offset=0};
768              ppTycBind ppstrm (tyc, env);              ppTycBind ppstrm (tyc, env);
769              closeBox())              closeBox())
# Line 881  Line 879 
879            (pps ppstrm "FE.V:"; ppEntPath ppstrm ep)            (pps ppstrm "FE.V:"; ppEntPath ppstrm ep)
880         | M.CONSTfct { rpath, ... } =>         | M.CONSTfct { rpath, ... } =>
881            (pps ppstrm "FE.C:"; ppInvPath ppstrm rpath)            (pps ppstrm "FE.C:"; ppInvPath ppstrm rpath)
        | M.LAMBDA_TP {param, 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)  
882         | M.LAMBDA {param, paramRlzn, body} =>         | M.LAMBDA {param, paramRlzn, body} =>
883            (openHVBox ppstrm (PP.Rel 0);            (openHVBox ppstrm (PP.Rel 0);
884              pps ppstrm "FE.L:"; break ppstrm {nsp=1,offset=1};              pps ppstrm "FE.L:"; break ppstrm {nsp=1,offset=1};

Legend:
Removed from v.3287  
changed lines
  Added in v.3322

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