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/database.sml
ViewVC logotype

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

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

revision 3174, Thu Jul 31 17:55:01 2008 UTC revision 3175, Thu Jul 31 19:04:20 2008 UTC
# Line 31  Line 31 
31      fun set_eri eri =      fun set_eri eri =
32          (extRefInfo := eri)          (extRefInfo := eri)
33    
34        fun get_hash (A.EXTERN e) = e
35          | get_hash (A.PATH (a, _)) = get_hash a
36          | get_hash _ = bug "get_hash"
37    
38      (* faire un redblacktree autour pour les differents fichiers + serializer*)      (* faire un redblacktree autour pour les differents fichiers + serializer*)
39      structure OccurrenceKey : ORD_KEY =      structure OccurrenceKey : ORD_KEY =
# Line 78  Line 81 
81          fun compare ((pid1, _), (pid2, _))= PersStamps.compare (pid1, pid2)          fun compare ((pid1, _), (pid2, _))= PersStamps.compare (pid1, pid2)
82      end      end
83      structure PidFileSet = RedBlackSetFn (PidFileKey)      structure PidFileSet = RedBlackSetFn (PidFileKey)
84    
85      val pid_file = ref PidFileSet.empty      val pid_file = ref PidFileSet.empty
86    
87      fun print_pids () =      fun print_pids () =
88          ( PidFileSet.app          ( PidFileSet.app
89                (fn (x,y) => print (PersStamps.toHex x ^ "->" ^ y ^ ", "))                (fn (x,y) => print (PersStamps.toHex x ^ "->" ^ y ^ ", "))
90                (!pid_file);                (!pid_file);
91            print "\n"            print "\n"
92          )          )
93    
94        fun get_pid file =
95            case PidFileSet.find (fn (_,x) => file = x) (!pid_file) of
96                NONE => bug ("get_pid" ^ file)
97              | SOME (x, _) => x
98    
99        fun get_file e =
100            case PidFileSet.find (fn (pid, _) => persstamps_eq (pid,e)) (!pid_file)
101             of NONE => bug "get_file"
102              | SOME (_, filename) => filename
103    
104      (******)      (******)
105    
106      fun is_available_rsl rev_symbol_list =      fun is_available_rsl rev_symbol_list =
# Line 402  Line 418 
418    
419      (****** end of set definitions *****)      (****** end of set definitions *****)
420    
421        fun print_all () = (
422            print "****** VAR : \n";print_var ();
423            print "****** STR : \n";print_str ();
424            print "****** TYP : \n";print_ty ();
425            print "****** CON : \n";print_cons ();
426            print "****** SIG : \n";print_sig ();
427            print "****** EXT : \n";print_ext ();
428            print "****** OCC : \n";print_occ ()
429        )
430    
431        fun print_all_g () = (
432            print "****** VAR : \n";print_var_g ();
433            print "****** STR : \n";print_str_g ();
434            print "****** TYP : \n";print_ty_g ();
435            print "****** CON : \n";print_cons_g ();
436            print "****** SIG : \n";print_sig_g ();
437            print "****** EXT : \n";print_ext ();
438            print "****** LVA : \n";print_lvars ();
439            print "****** PID : \n";print_pids ();
440            print "****** OCC : \n";print_occ_g ()
441        )
442    
443    
444        fun clear () = (
445            clear_lvar ();
446            var_set := VarSet.empty;
447            typ_set := TypSet.empty;
448            con_set := ConSet.empty;
449            str_set := StrSet.empty;
450            sig_set := SigSet.empty;
451            ext_set := ExtSet.empty;
452            occ_set := OccSet.empty;
453            source := "";
454            extRefInfo := (fn _ => NONE)
455        )
456    
457        (***********************)
458    
459      fun get_lvar0 set file test test2 (acc as A.PATH (a, slot)) =      fun get_lvar0 set file test test2 (acc as A.PATH (a, slot)) =
460          ( case get_lvar0 set file test2 test2 a of          ( case get_lvar0 set file test2 test2 a of
461                NONE => NONE                NONE => NONE
# Line 926  Line 980 
980    
981    
982    
983      fun print_all () = (      (***** pickling/unpickling function *****)
         print "****** VAR : \n";print_var ();  
         print "****** STR : \n";print_str ();  
         print "****** TYP : \n";print_ty ();  
         print "****** CON : \n";print_cons ();  
         print "****** SIG : \n";print_sig ();  
         print "****** EXT : \n";print_ext ();  
         print "****** OCC : \n";print_occ ()  
     )  
   
     fun print_all_g () = (  
         print "****** VAR : \n";print_var_g ();  
         print "****** STR : \n";print_str_g ();  
         print "****** TYP : \n";print_ty_g ();  
         print "****** CON : \n";print_cons_g ();  
         print "****** SIG : \n";print_sig_g ();  
         print "****** EXT : \n";print_ext ();  
         print "****** LVA : \n";print_lvars ();  
         print "****** PID : \n";print_pids ();  
         print "****** OCC : \n";print_occ_g ()  
     )  
   
   
     fun clear () = (  
         clear_lvar ();  
         var_set := VarSet.empty;  
         typ_set := TypSet.empty;  
         con_set := ConSet.empty;  
         str_set := StrSet.empty;  
         sig_set := SigSet.empty;  
         ext_set := ExtSet.empty;  
         occ_set := OccSet.empty;  
         source := "";  
         extRefInfo := (fn _ => NONE)  
     )  
   
984      fun get_strings (a, b, c, d, e, f, g, h, i) =      fun get_strings (a, b, c, d, e, f, g, h, i) =
985          ( SerializeDB.varToString  (VarSet.listItems a),          ( SerializeDB.varToString  (VarSet.listItems a),
986            SerializeDB.typeToString (TypSet.listItems b),            SerializeDB.typeToString (TypSet.listItems b),
# Line 997  Line 1016 
1016          in String.concat (insert "\n" [a,b,c,d,e,f,g,h,i])          in String.concat (insert "\n" [a,b,c,d,e,f,g,h,i])
1017          end          end
1018    
1019        (* directly reads from a file instead of loading when called by CM *)
1020      fun load_return source =      fun load_return source =
1021          let val os = TextIO.openIn source          let val os = TextIO.openIn source
1022              fun get_val NONE = bug ("sourcefile " ^ source ^ ":unexpected EOF")              fun get_val NONE = bug ("sourcefile " ^ source ^ ":unexpected EOF")
# Line 1006  Line 1026 
1026              get_sets (gs(),gs(),gs(),gs(),gs(),gs(),gs(),gs(),gs())              get_sets (gs(),gs(),gs(),gs(),gs(),gs(),gs(),gs(),gs())
1027          end          end
1028    
1029      fun get_file e =      (***** merging functions ******)
         case PidFileSet.find  
                  (fn (pid, _) => persstamps_eq (pid,e))  
                  (!pid_file)  
          of NONE => bug "get_file"  
           | SOME (_, filename) => filename  
1030    
1031        (* takes an extern path and gives back a filepath and its non simplified
1032         * local access in that file *
1033         * PATH (PATH (EXTERN _), 1), 0) -> (PATH (LVAR _, 0),"file.sml")
1034         *)
1035      fun modify_path (a as A.PATH (A.EXTERN e, _)) lv =      fun modify_path (a as A.PATH (A.EXTERN e, _)) lv =
1036          ( case LvarExtSet.find (fn (ext_acc, _) => equal_acc a ext_acc) lv of          ( case LvarExtSet.find (fn (ext_acc, _) => equal_acc a ext_acc) lv of
1037                NONE => bug ("modify_path2 " ^ A.prAcc a)                NONE => bug ("modify_path2 " ^ A.prAcc a)
# Line 1024  Line 1043 
1043          end          end
1044        | modify_path _ _ = bug "modify_path1"        | modify_path _ _ = bug "modify_path1"
1045    
1046        (* takes the uses referenced in ext and distributes them to their
1047         * definition points *)
1048      fun distribution (va,ty,co,st,si,lv) ext =      fun distribution (va,ty,co,st,si,lv) ext =
1049          case ext of          case ext of
1050              ExtVar {access, usage} =>              ExtVar {access, usage} =>
# Line 1062  Line 1083 
1083                  | SOME {usage = u, ...} => u := !usage @ !u                  | SOME {usage = u, ...} => u := !usage @ !u
1084              *)              *)
1085    
1086      fun get_pid file =      (* merges the given sets into the global database *)
         case PidFileSet.find (fn (_,x) => file = x) (!pid_file) of  
             NONE => bug ("get_pid" ^ file)  
           | SOME (x, _) => x  
   
     fun get_hash (A.EXTERN e) = e  
       | get_hash (A.PATH (a, _)) = get_hash a  
       | get_hash _ = bug "get_hash"  
   
1087      fun merge (var,ty,cons,str,sign,ext,lvarext,pid',occ) sourcefile =      fun merge (var,ty,cons,str,sign,ext,lvarext,pid',occ) sourcefile =
1088          let val var_set2 = ref var          let val var_set2 = ref var
1089              val typ_set2 = ref ty              val typ_set2 = ref ty
# Line 1081  Line 1094 
1094                                          str_set_g, sig_set_g, !lvar_ext)                                          str_set_g, sig_set_g, !lvar_ext)
1095          in          in
1096              ExtSet.app distrib ext;              ExtSet.app distrib ext;
1097              (* ICI, IL FAUT SIMPLIFIER STR_SET2 EN REGARDANT LES DEFINITIONS              (*  SIMPLIFIER STR_SET2 EN REGARDANT LES DEFINITIONS
1098               *  EXTERIEURES (C'EST A DIRE PATH (_) CAR LES AUTRES ONT ETE               *  EXTERIEURES (C'EST A DIRE PATH (_) CAR LES AUTRES ONT ETE
1099               * SIMPLIFIEES EN LVAR) ET EN LES REMPLACANT SOMEHOW PAR UN COUPLE               * SIMPLIFIEES EN LVAR) ET EN LES REMPLACANT SOMEHOW PAR UN COUPLE
1100               * (LVAR, FILEPATH) *)               * (LVAR, FILEPATH) ? *)
1101              occ_set_g := OccSetG.add (!occ_set_g, (occ, sourcefile));              occ_set_g := OccSetG.add (!occ_set_g, (occ, sourcefile));
1102              var_set_g := VarSet.union (!var_set_g, !var_set2);              var_set_g := VarSet.union (!var_set_g, !var_set2);
1103              typ_set_g := TypSet.union (!typ_set_g, !typ_set2);              typ_set_g := TypSet.union (!typ_set_g, !typ_set2);
# Line 1099  Line 1112 
1112                                   NONE => bug "merge"                                   NONE => bug "merge"
1113                                 | SOME pid'' => (pid'', sourcefile)                                 | SOME pid'' => (pid'', sourcefile)
1114                              );                              );
1115                (* we may be merging a file that was removed before, but did not
1116                 * provoked recompilation of files using it
1117                 * in that case, there are links to that files in the set that have
1118                 * to be taken care of *)
1119              let val pid = get_pid sourcefile              let val pid = get_pid sourcefile
1120                  val (to_be_added, others) =                  val (to_be_added, others) =
1121                      ExtSet.partition                      ExtSet.partition
# Line 1112  Line 1129 
1129              end              end
1130          end          end
1131    
1132        (* merge the given pickle in the global database
1133         * called by CM via the srcInfo module*)
1134      fun merge_pickle sourcefile pickle =      fun merge_pickle sourcefile pickle =
1135          case String.tokens (fn x => x = #"\n") pickle of          case String.tokens (fn x => x = #"\n") pickle of
1136              [a,b,c,d,e,f,g,h,i] =>              [a,b,c,d,e,f,g,h,i] =>
1137              merge (get_sets (a,b,c,d,e,f,g,h,i)) sourcefile              merge (get_sets (a,b,c,d,e,f,g,h,i)) sourcefile
1138            | l => bug ("merge_pickle " ^ Int.toString (List.length l))            | l => bug ("merge_pickle " ^ Int.toString (List.length l))
1139    
1140        (* loading and merging manually a file *)
1141      fun load_merge sourcefile =      fun load_merge sourcefile =
1142          let val sl = String.tokens (fn x => x = #"/") sourcefile          let val sl = String.tokens (fn x => x = #"/") sourcefile
1143              fun modi [a] = [".cm","INFO",a]              fun modi [a] = [".cm","INFO",a]
# Line 1128  Line 1148 
1148              merge (load_return sourcefile2) sourcefile              merge (load_return sourcefile2) sourcefile
1149          end          end
1150    
1151    
1152        (**** funtions to remove a file from the database  *****)
1153    
1154        (* gives back the slot of the access_son in the access_parent structure *)
1155      fun find_son access_par access_son file good_key =      fun find_son access_par access_son file good_key =
1156          case StrSet.find (str_pred (access_par, file)) (!str_set_g)          case StrSet.find (str_pred (access_par, file)) (!str_set_g)
1157           of NONE => bug "find_son"           of NONE => bug "find_son"
# Line 1156  Line 1180 
1180                    | SOME {parent = SOME access_loc_parent, ...} =>                    | SOME {parent = SOME access_loc_parent, ...} =>
1181                      let val access_lvar_parent= get_str_lvar access_loc_parent                      let val access_lvar_parent= get_str_lvar access_loc_parent
1182                          val access_ext_parent = str access_lvar_parent                          val access_ext_parent = str access_lvar_parent
1183                          val is_alias =                          val slot = find_son2 access_lvar_parent access
1184                              ( case StrSet.find                      in  A.PATH (access_ext_parent, slot)
                                        (str_pred (access_lvar_parent, file))  
                                        (!str_set_g)  
                                of NONE => bug "externalize2"  
                                 | SOME {elements = Alias a, ...} => true  
                                 | _ => false  
                             )  
                     in  
                         if is_alias then  
                             access_ext_parent  
                         else  
                             let val slot = find_son2 access_lvar_parent access  
                             in (A.PATH (access_ext_parent, slot))  
                             end  
1185                      end                      end
1186                    | SOME {parent = NONE, ...} =>                    | SOME {parent = NONE, ...} =>
1187                      let val pid = get_pid file in                      let val pid = get_pid file in
# Line 1284  Line 1295 
1295                             (!str_set_g)                             (!str_set_g)
1296          )          )
1297    
     fun test () =  
         let val (a,b,c,d,e,f,g,h,i) =  
                 get_sets (get_strings (!var_set, !typ_set, !con_set, !str_set,  
                                        !sig_set, !ext_set, !lvar_ext, !pid,  
                                        !occ_set)  
                          )  
         in  
             if VarSet.numItems a <> VarSet.numItems (!var_set) then  
                 bug "test ().var length"  
             else  
                 ();  
             if TypSet.numItems b <> TypSet.numItems (!typ_set) then  
                 bug "test ().type length"  
             else  
                 ();  
             if ConSet.numItems c <> ConSet.numItems (!con_set) then  
                 bug "test ().cons length"  
             else  
                 ();  
             if StrSet.numItems d <> StrSet.numItems (!str_set) then  
                 bug "test ().str length"  
             else  
                 ();  
             if SigSet.numItems e <> SigSet.numItems (!sig_set) then  
                 bug "test ().sig length"  
             else  
                 ();  
             if ExtSet.numItems f <> ExtSet.numItems (!ext_set) then  
                 bug "test ().ext length"  
             else  
                 ();  
             if LvarExtSet.numItems g <>LvarExtSet.numItems (!lvar_ext) then  
                 bug "test ().lvar_ext length"  
             else  
                 ();  
             if OccSet.numItems i <>OccSet.numItems (!occ_set) then  
                 bug "test ().lvar_ext length"  
             else  
                 ();  
             VarSet.app P.print_var a;  
             TypSet.app P.print_type b;  
             ConSet.app P.print_cons c;  
             StrSet.app P.print_str d;  
             SigSet.app P.print_sig e;  
             ExtSet.app P.print_ext f;  
             print_lvars ();  
             OccSet.app P.print_occ i  
         end  
   
   
1298  end (*end local*)  end (*end local*)
1299  end (*structure Database *)  end (*structure Database *)

Legend:
Removed from v.3174  
changed lines
  Added in v.3175

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