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

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

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

revision 3131, Wed Jul 23 19:00:55 2008 UTC revision 3132, Wed Jul 23 20:20:58 2008 UTC
# Line 40  Line 40 
40      val set_pid : PersStamps.persstamp -> unit      val set_pid : PersStamps.persstamp -> unit
41      val clear_lvar : unit -> unit      val clear_lvar : unit -> unit
42      val clear : unit -> unit      val clear : unit -> unit
43      val save : unit -> unit      val clear_all : unit -> unit
44      val load_replace : string -> unit      (*val save : unit -> unit*)
45      val load_merge : string -> unit      val load_merge : string -> unit
46        val merge_pickle : string -> string -> unit
47      val test : unit -> unit      val test : unit -> unit
48        val get_pickle : unit -> string
49    
50      val find_var : (Ens_types2.var_elem -> bool) -> Ens_types2.var_elem option      val find_var : (Ens_types2.var_elem -> bool) -> Ens_types2.var_elem option
51      val exists_var :      val exists_var :
# Line 91  Line 93 
93      open Conversion      open Conversion
94  in  in
95      val source = ref ""      val source = ref ""
96      fun set_source s =      fun set_source s = source := s
         source := OS.FileSys.getDir () ^ "/" ^ s  
97    
98      val pid = ref NONE : PersStamps.persstamp option ref      val pid = ref NONE : PersStamps.persstamp option ref
99      fun set_pid pid' = pid := SOME pid'      fun set_pid pid' = pid := SOME pid'
# Line 100  Line 101 
101       * not pickled       * not pickled
102       * when unpickled, this string is initialised with the name of the file       * when unpickled, this string is initialised with the name of the file
103       * just unpickled *)       * just unpickled *)
     val lvar_ext = ref [] :  (A.access * A.access) list ref  
104      val lvars = ref [] : A.access list ref      val lvars = ref [] : A.access list ref
105      val exts = ref [] : A.access list ref      val exts = ref [] : A.access list ref
106    
107      fun clear_lvar () = (lvars := []; exts := []; lvar_ext := []; pid := NONE)      fun clear_lvar () = (lvars := []; exts := []; pid := NONE)
108      fun add_lvar access = lvars := access :: !lvars      fun add_lvar access = lvars := access :: !lvars
109      fun add_ext_acc access = exts := access :: !exts      fun add_ext_acc access = exts := access :: !exts
     fun pickling_over () = lvar_ext := ListPair.zipEq (!lvars, !exts)  
   
     fun print_lvars () =  
         case !lvar_ext of  
             [] => print "No exports\n"  
           | l =>  
             ( List.app  
                   (fn (x, y) => print (A.prAcc x ^ "->" ^ A.prAcc y ^ ", "))  
                   l;  
               print "\n"  
             )  
110    
111      val extRefInfo = ref (fn _ => NONE) : (Symbol.symbol -> string option) ref      val extRefInfo = ref (fn _ => NONE) : (Symbol.symbol -> string option) ref
112      fun set_eri eri =      fun set_eri eri =
113          (extRefInfo := eri)          (extRefInfo := eri)
114    
115        val pid_file = ref [] : (PersStamps.persstamp * string) list ref
116        fun print_pids () =
117            ( List.app
118                  (fn (x,y) => print (PersStamps.toHex x ^ "->" ^ y ^ ", "))
119                  (!pid_file);
120              print "\n"
121            )
122        (******)
123    
124      fun is_available_rsl rev_symbol_list =      fun is_available_rsl rev_symbol_list =
125          !extRefInfo (List.last rev_symbol_list) <> NONE          !extRefInfo (List.last rev_symbol_list) <> NONE
126    
# Line 139  Line 137 
137        | is_accessible (A.PATH (s, _)) = is_accessible s        | is_accessible (A.PATH (s, _)) = is_accessible s
138        | is_accessible (A.LVAR _) = SOME true        | is_accessible (A.LVAR _) = SOME true
139    
140        (******)
   
141    
142      fun compare_acc (A.LVAR i, A.LVAR j) = Int.compare (i,j)      fun compare_acc (A.LVAR i, A.LVAR j) = Int.compare (i,j)
143        | compare_acc (A.LVAR _, _) = LESS        | compare_acc (A.LVAR _, _) = LESS
# Line 158  Line 155 
155        | compare_acc (_, A.PATH _) = GREATER        | compare_acc (_, A.PATH _) = GREATER
156        | compare_acc (A.NO_ACCESS, A.NO_ACCESS) = EQUAL        | compare_acc (A.NO_ACCESS, A.NO_ACCESS) = EQUAL
157    
158        (*mapping from PATH (... EXTERN) to LVAR*)
159        structure LvarExtKey : ORD_KEY =
160        struct
161            type ord_key = A.access * A.access
162            fun compare ((acc1, _), (acc2, _))= compare_acc (acc1,acc2)
163        end
164        structure LvarExtSet = RedBlackSetFn (LvarExtKey)
165        val lvar_ext = ref LvarExtSet.empty
166    
167        fun pickling_over () =
168            lvar_ext := LvarExtSet.addList ( !lvar_ext,
169                                             ListPair.zipEq (!exts, !lvars)
170                                           )
171        fun print_lvars () =
172            if LvarExtSet.isEmpty (!lvar_ext) then
173                print "No exports\n"
174            else
175                ( LvarExtSet.app
176                      (fn (x, y) => print (A.prAcc x ^ "->" ^ A.prAcc y ^ ", "))
177                      (!lvar_ext);
178                  print "\n"
179                )
180    
181        (* end of LvarExt part*)
182    
183      fun compare_loc_acc (loc1, loc2) accs =      fun compare_loc_acc (loc1, loc2) accs =
184          case String.compare (locFile loc1, locFile loc2) of          case String.compare (locFile loc1, locFile loc2) of
185              EQUAL => compare_acc accs              EQUAL => compare_acc accs
# Line 621  Line 643 
643                  List.mapPartial get_trip bl                  List.mapPartial get_trip bl
644    
645              fun get_slot (A.PATH (_, s)) = s              fun get_slot (A.PATH (_, s)) = s
646                  | get_slot acc = bug ("Ens_var2.add_str_def.get_slot")
647    
648              val elements'' =              val elements'' =
649                  case elements' of                  (*case elements' of
650                      (_, _, Var (A.PATH (acc, _)))::_ =>                      (_, _, (Var (A.PATH (acc, _))|Str (A.PATH (acc, _))))::_ =>
651                        ( case is_accessible acc of
652                              (* et si on fait structure s = ...; structure s2 = struct open s ... end?*)
653                              NONE => bug "add_str_def.elements''"
654                            | SOME true =>
655                      Constraint                      Constraint
656                          ( List.map                          ( List.map
657                                (fn ((x, y, Var z) | (x, y, Str z)) =>                                (fn ((x, y, Var z) | (x, y, Str z)) =>
658                                    (x, y, get_slot z))                                          ( print (Int.toString x ^ " " ^ Symbol.name y ^ " " ^
659                                                     A.prAcc z ^ "\n");
660                                              (x, y, get_slot z)
661                                            )
662                                        )
663                                elements',                                elements',
664                            acc                            acc
665                          )                          )
666                    | _ =>                        | SOME false => Def elements'
667                        )
668                      | _ => *)
669                      Def elements'                      Def elements'
670    
671          in          in
# Line 711  Line 744 
744          print_cons ();          print_cons ();
745          print_sig ();          print_sig ();
746          print_ext ();          print_ext ();
747          print_lvars ()(*;          print_lvars ();
748          print_pid ()*)          print_pids ()
749      )      )
750    
751    
# Line 723  Line 756 
756          ens_str := StrSet.empty;          ens_str := StrSet.empty;
757          ens_sig := SigSet.empty;          ens_sig := SigSet.empty;
758          ens_ext := ExtSet.empty;          ens_ext := ExtSet.empty;
759            pid_file := [];
760          source := "";          source := "";
761          extRefInfo := (fn _ => NONE)          extRefInfo := (fn _ => NONE)
762      )      )
763    
764        fun clear_all () =
765            ( clear ();
766              clear_lvar ()
767            )
768    
769      fun get_strings (a, b, c, d, e, f, g, h) =      fun get_strings (a, b, c, d, e, f, g, h) =
770          TyToString.varToString  (VarSet.listItems  a) ::          ( TyToString.varToString     (VarSet.listItems  a),
771          TyToString.typeToString (TySet.listItems   b) ::            TyToString.typeToString    (TySet.listItems   b),
772          TyToString.consToString (ConsSet.listItems c) ::            TyToString.consToString    (ConsSet.listItems c),
773          TyToString.strToString  (StrSet.listItems  d) ::            TyToString.strToString     (StrSet.listItems  d),
774          TyToString.sigToString  (SigSet.listItems  e) ::            TyToString.sigToString     (SigSet.listItems  e),
775          TyToString.extToString  (ExtSet.listItems  f) ::            TyToString.extToString     (ExtSet.listItems  f),
776          TyToString.lvarExtToString g ::            TyToString.lvarExtToString (LvarExtSet.listItems g),
777          TyToString.pidOptionToString h ::            TyToString.pidOptionToString h
778          nil          )
779    
780      fun get_sets (a, b, c, d, e, f, g, h) =      fun get_sets (a, b, c, d, e, f, g, h) =
781          ( VarSet.fromList  (StringToTy.stringToVar  a),          ( VarSet.fromList  (StringToTy.stringToVar  a),
# Line 745  Line 784 
784            StrSet.fromList  (StringToTy.stringToStr  d),            StrSet.fromList  (StringToTy.stringToStr  d),
785            SigSet.fromList  (StringToTy.stringToSig  e),            SigSet.fromList  (StringToTy.stringToSig  e),
786            ExtSet.fromList  (StringToTy.stringToExt  f),            ExtSet.fromList  (StringToTy.stringToExt  f),
787            StringToTy.stringToLvarExt g,            LvarExtSet.fromList (StringToTy.stringToLvarExt g),
788            StringToTy.stringToPidOption h            StringToTy.stringToPidOption h
789          )          )
790    
791    
792      fun pickfile str = str ^ ".si"      (*fun pickfile str = str ^ ".si"*)
793    
794        fun get_pickle () =
795            let val (a,b,c,d,e,f,g,h) =
796                    get_strings (!ens_var, !ens_ty, !ens_cons, !ens_str,
797                                 !ens_sig, !ens_ext, !lvar_ext, !pid)
798            in String.concat
799                   [a,"\n",b,"\n",c,"\n",d,"\n",e,"\n",f,"\n",g,"\n",h,"\n"]
800            end
801    
802      fun save_to_file sourcefile =      (*fun save_to_file sourcefile =
803          if sourcefile = "<instream>" orelse          if String.isSuffix "<instream>" sourcefile orelse
804             sourcefile = "stdIn" orelse             String.isSuffix "stdIn" sourcefile orelse
805             String.isSuffix "-export.sml" sourcefile             String.isSuffix "-export.sml" sourcefile
806          then          then
807              ()              ()
808          else          else
809               let val new_source = pickfile sourcefile               let val new_source = pickfile sourcefile
810                   val os = TextIO.openOut new_source                   val os = TextIO.openOut new_source
811                   val s = get_strings (!ens_var, !ens_ty, !ens_cons, !ens_str,                   val (a,b,c,d,e,f,g,h) =
812                         get_strings (!ens_var, !ens_ty, !ens_cons, !ens_str,
813                                        !ens_sig, !ens_ext, !lvar_ext, !pid)                                        !ens_sig, !ens_ext, !lvar_ext, !pid)
814               in  List.app (fn x => (TextIO.output (os, x);                   fun write x = ( TextIO.output (os, x);
815                                      TextIO.output (os, "\n")))                                   TextIO.output (os, "\n")
816                            s;                                 )
817    
818                 in  write a; write b; write c; write d;
819                     write e; write f; write g; write h;
820                   TextIO.flushOut os;                   TextIO.flushOut os;
821                   TextIO.closeOut os;                   TextIO.closeOut os;
822                   print ("Wrote to file " ^ new_source ^ "\n")                   print ("Wrote to file " ^ new_source ^ "\n")
823               end               end
824    
825      fun save () = save_to_file (!source)      fun save () = save_to_file (!source)*)
826    
827      fun load_return sourcefile =      fun load_return source =
828          let val new_source = pickfile sourcefile          let val os = TextIO.openIn source
829              val os = TextIO.openIn new_source              fun get_val NONE = bug ("sourcefile " ^ source ^ ":unexpected EOF")
             fun get_val NONE = bug ("sourcefile "^new_source^":unexpected EOF")  
830                | get_val (SOME s) = s                | get_val (SOME s) = s
831              fun gs () = get_val (TextIO.inputLine os)              fun gs () = get_val (TextIO.inputLine os)
             val (var,ty,cons,str,sign,ext,lvarext,pid')=  
                 get_sets (gs(),gs(),gs(),gs(),gs(),gs(),gs(),gs())  
832          in          in
833              (var, ty, cons, str, sign, ext, lvarext, pid')              get_sets (gs(),gs(),gs(),gs(),gs(),gs(),gs(),gs())
         end  
   
     val pid_file = ref [] : (PersStamps.persstamp * string) list ref  
   
     fun load_replace sourcefile =  
         let val (var,ty,cons,str,sign,ext,lvarext,pid')=load_return sourcefile  
         in  ens_var := var;  
             ens_ty := ty;  
             ens_cons := cons;  
             ens_str := str;  
             ens_sig := sign;  
             ens_ext := ext;  
             lvar_ext := lvarext;  
             (*pid := pid'*)  
             pid_file := ( case pid' of  
                               NONE => bug "load_replace"  
                             | SOME pid'' => [(pid'', sourcefile)]  
                         )  
834          end          end
835    
836      fun get_file e =      fun get_file e =
# Line 809  Line 839 
839            | SOME (_, filename) => filename            | SOME (_, filename) => filename
840    
841      fun modify_path (a as A.PATH (A.EXTERN e, _)) lv =      fun modify_path (a as A.PATH (A.EXTERN e, _)) lv =
842          ( case List.find (fn (_, ext_acc) => ext_acc = a) lv of          ( case LvarExtSet.find (fn (ext_acc, _) => ext_acc = a) lv of
843                NONE => bug "modify_path2"                NONE => bug ("modify_path2 " ^ A.prAcc a)
844              | SOME (loc_acc, _) => (loc_acc, get_file e)              | SOME (_, loc_acc) => (loc_acc, get_file e)
845          )          )
846        | modify_path (A.PATH (a, slot)) lv =        | modify_path (A.PATH (a, slot)) lv =
847          let val (a', file) = modify_path a lv in          let val (a', file) = modify_path a lv in
# Line 861  Line 891 
891                  | SOME {usage = u, ...} => u := !usage @ !u                  | SOME {usage = u, ...} => u := !usage @ !u
892              *)              *)
893    
894      fun load_merge sourcefile =      fun merge (var,ty,cons,str,sign,ext,lvarext,pid') sourcefile =
895          let val (var,ty,cons,str,sign,ext,lvarext,pid')=load_return sourcefile          let val ens_var2 = ref var
             val ens_var2 = ref var  
896              val ens_ty2 = ref ty              val ens_ty2 = ref ty
897              val ens_cons2 = ref cons              val ens_cons2 = ref cons
898              val ens_str2 = ref str              val ens_str2 = ref str
# Line 878  Line 907 
907              ens_str  := StrSet.union  (!ens_str,  !ens_str2);              ens_str  := StrSet.union  (!ens_str,  !ens_str2);
908              ens_sig  := SigSet.union  (!ens_sig,  !ens_sig2);              ens_sig  := SigSet.union  (!ens_sig,  !ens_sig2);
909              (*ens_ext := ext; should be empty anyway*)              (*ens_ext := ext; should be empty anyway*)
910              lvar_ext := lvarext @ !lvar_ext;              lvar_ext := LvarExtSet.union (lvarext,!lvar_ext);
911              (*pid := pid'*)              (*pid := pid'*)
912              pid_file := ( case pid' of              pid_file := ( case pid' of
913                                NONE => bug "load_merge"                                NONE => bug "merge"
914                              | SOME pid'' => (pid'', sourcefile) :: !pid_file                              | SOME pid'' => (pid'', sourcefile) :: !pid_file
915                          )                          )
916          end          end
917    
918        fun merge_pickle sourcefile pickle =
919            case String.tokens (fn x => x = #"\n") pickle of
920                [a,b,c,d,e,f,g,h] => merge (get_sets (a,b,c,d,e,f,g,h)) sourcefile
921              | l => bug ("merge_pickle " ^ Int.toString (List.length l))
922    
923        fun load_merge sourcefile =
924            merge (load_return sourcefile) sourcefile
925    
926    
927        (*********** A FAIRE ***********)
928        (*fun remove file =
929            ens_ext := ExtSet.empty;
930            VarSet.app ( fn {usage, ...} =>
931                            usage := List.filter
932                                         (fn (x, _, _) => locFile x <> file)
933                                         (!usage)
934                       )
935                       (!ens_var);
936            ens_var := VarSet.filter
937                           (fun {def, usage, ...} =>
938                                ExtSet.addList (!ens_ext, (List.map Var (!usage)))
939                                locFile def <> file)
940                           (!ens_var)*)
941    
942      fun test () =      fun test () =
943          let val s = get_strings (!ens_var, !ens_ty, !ens_cons, !ens_str,          let val (a,b,c,d,e,f,g,h) =
944                    get_sets ( get_strings (!ens_var, !ens_ty, !ens_cons, !ens_str,
945                                   !ens_sig, !ens_ext, !lvar_ext, !pid)                                   !ens_sig, !ens_ext, !lvar_ext, !pid)
946              val (a,b,c,d,e,f,g,h) =                           )
                 case s of  
                     [a, b, c, d, e, f, g, h]=>get_sets (a, b, c, d, e, f, g, h)  
                   | _ => bug "test"  
947              val () =              val () =
948                  if VarSet.numItems a <> VarSet.numItems (!ens_var) then                  if VarSet.numItems a <> VarSet.numItems (!ens_var) then
949                      bug "test ().var length"                      bug "test ().var length"
# Line 925  Line 975 
975                  else                  else
976                      ()                      ()
977              val () =              val () =
978                  if List.length g <> List.length (!lvar_ext) then                  if LvarExtSet.numItems g <>LvarExtSet.numItems (!lvar_ext) then
979                      bug "test ().lvar_ext length"                      bug "test ().lvar_ext length"
980                  else                  else
981                      ()                      ()

Legend:
Removed from v.3131  
changed lines
  Added in v.3132

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