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/gatien-branch/compiler/Elaborator/srcinfo/ens_print.sml
ViewVC logotype

Diff of /sml/branches/gatien-branch/compiler/Elaborator/srcinfo/ens_print.sml

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

revision 3089, Thu Jun 26 21:23:51 2008 UTC revision 3090, Tue Jul 1 18:59:32 2008 UTC
# Line 1  Line 1 
1  signature ENS_PRINT =  signature ENS_PRINT =
2  sig  sig
    type file  
    type location  
    type var_elem  
    type type_elem  
    type cons_elem  
    type str_elem  
    type sig_elem  
    type all  
   
3     val maj : StaticEnv.staticEnv -> unit     val maj : StaticEnv.staticEnv -> unit
4    
5     val rtoS : location -> string     val rtoS : Ens_types.location -> string
6     val stoS : Symbol.symbol -> string     val stoS : Symbol.symbol -> string
7     val ptoS : Symbol.symbol list -> string     val ptoS : Symbol.symbol list -> string
8     val rptoS : InvPath.path -> string     val rptoS : InvPath.path -> string
9    
10     val print_var : var_elem -> unit     val print_var : Ens_types.var_elem -> unit
11     val print_type : type_elem -> unit     val print_type : Ens_types.type_elem -> unit
12     val print_cons : cons_elem -> unit     val print_cons : Ens_types.cons_elem -> unit
13     val print_str : str_elem -> unit     val print_str : Ens_types.str_elem -> unit
14     val print_sig : sig_elem -> unit     val print_sig : Ens_types.sig_elem -> unit
15     val print_all : all -> unit     val print_all : Ens_types.all -> unit
16    
17  end (* signature ENS_PRINT*)  end (* signature ENS_PRINT*)
18    
# Line 35  Line 26 
26      structure PP = PrettyPrintNew      structure PP = PrettyPrintNew
27      structure VC = VarCon      structure VC = VarCon
28      structure M = Modules      structure M = Modules
29        open Ens_types
30  in  in
31    
32     fun bug msg = ErrorMsg.impossible("Bugs in Ens_print: "^msg);     fun bug msg = ErrorMsg.impossible("Bugs in Ens_print: "^msg);
# Line 42  Line 34 
34     val stat_env = ref (StaticEnv.empty);     val stat_env = ref (StaticEnv.empty);
35     fun maj e = stat_env := e;     fun maj e = stat_env := e;
36    
    type file = string  
    type location = file * int * int  
    type var_elem = {var : VC.var, def : location, usage : (location * T.ty) list ref}  
    type type_elem = {tycon : T.tycon, def : location, usage : (location * T.ty) list ref}  
    type cons_elem = {cons : T.datacon, def : location, usage : (location * T.ty) list ref}  
    type str_elem = {str : M.Structure, def : location, usage : (location * T.ty) list ref,  
                     map : (int * A.access) list ref}  
    type sig_elem = {sign : M.Signature, def : location, alias : (location * S.symbol) list ref,  
                     usage : (location * S.symbol) list ref}  
    type all = var_elem list * type_elem list * cons_elem list *  str_elem list * sig_elem list  
   
37    
38     (*tranform a region in a string*)     (*tranform a region in a string*)
39     fun rtoS (filename, int1, int2) =     fun rtoS (filename, int1, int2) =
# Line 77  Line 58 
58     fun printer0 ty env =     fun printer0 ty env =
59         (         (
60          (          (
61           (PP.with_default_pp (fn ppstrm => (PPType.resetPPType(); PPType.ppType env ppstrm ty)))           (PP.with_default_pp
62                  (fn ppstrm =>
63                      (PPType.resetPPType(); PPType.ppType env ppstrm ty)))
64           handle _ => print "fail to print anything"           handle _ => print "fail to print anything"
65          )          )
66         )         )
# Line 88  Line 71 
71     (*print the usage and instance of the environments*)     (*print the usage and instance of the environments*)
72     fun print_instance usage = (     fun print_instance usage = (
73         print " is used at :";         print " is used at :";
74         List.app (fn (x, y) => (print ("\n\t" ^ rtoS x ^ " with type "); printer y)) (!usage);         List.app
75               (fn (x, y) => (print ("\n\t" ^ rtoS x ^ " with type "); printer y))
76               (!usage);
77         print "\n"         print "\n"
78     )     )
79    
80     fun print_var {var, def, usage} = (     fun print_var {var, def, usage} = (
81         case var of         case var of
82             VC.VALvar {access, typ, path, ...} => (             VC.VALvar {access, typ, path, ...} => (
83             print (A.prAcc access ^ ": \"" ^ SymPath.toString path ^ "\" " ^ rtoS def ^ " has type ");             print (A.prAcc access ^ ": \"" ^ SymPath.toString path ^
84                      "\" " ^ rtoS def ^ " has type ");
85             printer (!typ)             printer (!typ)
86             )             )
87           | VC.ERRORvar => print ("ERRORvar : " ^ rtoS def)           | VC.ERRORvar => print ("ERRORvar : " ^ rtoS def)
# Line 109  Line 95 
95         case tycon of         case tycon of
96             (T.DEFtyc {tyfun = T.TYFUN {arity, body}, path, ...}) =>             (T.DEFtyc {tyfun = T.TYFUN {arity, body}, path, ...}) =>
97             (             (
98              print (rptoS path ^ " (arity " ^ Int.toString arity ^") "^ rtoS def ^" : ");              print (rptoS path ^ " (arity " ^ Int.toString arity ^") "^
99                       rtoS def ^" : ");
100              printer (body);              printer (body);
101              print_instance usage              print_instance usage
102             )             )
# Line 125  Line 112 
112                                  )                                  )
113                              )                              )
114                              dcons                              dcons
115                 val (sub as {tycname, arity, ...}) = Vector.sub (#members family,index)                 val (sub as {tycname, arity, ...}) =
116                       Vector.sub (#members family,index)
117             in             in
118                 print (stoS tycname ^ " (arity "^ Int.toString arity ^") "^ rtoS def ^ " : ");                 print (stoS tycname ^ " (arity "^ Int.toString arity ^
119                          ") "^ rtoS def ^ " : ");
120                 temp sub;                 temp sub;
121                 print_instance usage                 print_instance usage
122             end             end
# Line 159  Line 148 
148             (             (
149              case str of              case str of
150                  M.STR {access, rlzn = {rpath, ...}, ...} =>                  M.STR {access, rlzn = {rpath, ...}, ...} =>
151                  print ("("^A.prAcc access^") " ^ rptoS rpath ^ " " ^ rtoS def ^ " has slots")                  print ("("^A.prAcc access^") " ^ rptoS rpath ^ " " ^
152                           rtoS def ^ " has slots")
153                | M.ERRORstr => print ("ERRORstr" ^ rtoS def ^ " has slots")                | M.ERRORstr => print ("ERRORstr" ^ rtoS def ^ " has slots")
154                | M.STRSIG _ => print ("STRSIG" ^ rtoS def ^ " has slots");                | M.STRSIG _ => print ("STRSIG" ^ rtoS def ^ " has slots");
155              print_map (!map);              print_map (!map);
# Line 177  Line 167 
167    
168             fun print_inst usage = (             fun print_inst usage = (
169                 print " and is used at :";                 print " and is used at :";
170                 List.app (fn (x, y) => (print ("\n\t"^(rtoS x)^" with name "); print (stoS y))) (!usage);                 List.app
171                       (fn (x, y) => print ("\n\t"^(rtoS x)^" with name "^stoS y))
172                       (!usage);
173                 print "\n"                 print "\n"
174             )             )
175         in         in
# Line 185  Line 177 
177                 M.SIG {name, ...} => print_so name                 M.SIG {name, ...} => print_so name
178               | _ => ();               | _ => ();
179             print (" : "^rtoS def);             print (" : "^rtoS def);
180             List.app (fn (x, S.SYMBOL (_, str)) => print ("\n\thas alias "^ str ^ " " ^ (rtoS x))) (!alias);             List.app
181                   (fn (x, S.SYMBOL (_, str)) =>
182                       print ("\n\thas alias "^ str ^ " " ^ (rtoS x)))
183                   (!alias);
184             print_inst usage             print_inst usage
185         end         end
186    

Legend:
Removed from v.3089  
changed lines
  Added in v.3090

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