1(* this is an -*- sml -*- file *)
2val _ = use "poly/poly-init.ML";
3
4val _ = use "../tools/Holmake/Systeml.sig";
5val _ = use "Holmake/Systeml.sml"
6
7val _ = use "../tools/Holmake/QuoteFilter.sml";
8val _ = use "../tools/Holmake/HM_SimpleBuffer.sig";
9val _ = use "../tools/Holmake/HM_SimpleBuffer.sml";
10val _ = use "../tools/Holmake/QFRead.sig";
11val _ = use "../tools/Holmake/QFRead.sml";
12val _ = use "poly/quse.sig";
13val _ = use "poly/quse.sml";
14
15local
16
17  fun die s = (TextIO.output(TextIO.stdErr, s ^ "\n");
18               TextIO.flushOut TextIO.stdErr;
19               raise Fail s)
20
21  fun warn s = (TextIO.output(TextIO.stdErr, "WARNING: " ^ s ^ "\n");
22                TextIO.flushOut TextIO.stdErr)
23
24  val redirected_files = ["mlibOmegaint.sml"];
25  val meta_debug = ref false
26
27  fun MDBG s = if !meta_debug then
28                 TextIO.output(TextIO.stdOut, "META_DEBUG: " ^ s() ^ "\n")
29               else ()
30
31  fun try_remove f = ((OS.FileSys.remove f) handle OS.SysErr _ => ());
32  infix ++
33  fun p1 ++ p2 = OS.Path.concat (p1, p2)
34  open Systeml
35  fun unquote_to file1 file2 =
36      systeml [HOLDIR ++ "bin" ++ "unquote", file1, file2];
37
38structure FS = OS.FileSys
39
40val loadpathdb =
41    ref (Binarymap.mkDict String.compare : (string,string) Binarymap.dict)
42
43fun quse s = let
44  val _ = if FS.access (s, [FS.A_READ]) then ()
45          else die ("Use: non-existent file "^s)
46  val _ = MDBG (fn _ => "Call quse " ^ s)
47  val full = OS.Path.mkCanonical
48               (OS.Path.mkAbsolute{path = s, relativeTo = OS.FileSys.getDir()})
49in
50  QUse.use s ;
51  loadpathdb := Binarymap.insert(!loadpathdb,OS.Path.file full,OS.Path.dir full)
52end handle OS.Path.Path => die ("Path exception in quse "^s)
53             | e => (TextIO.output(TextIO.stdErr,
54                                   "error in quse " ^ s ^ " : " ^
55                                   General.exnMessage e ^ "\n");
56                     TextIO.flushOut TextIO.stdErr;
57                     raise e)
58
59fun myuse f =
60  let val op ++ = OS.Path.concat
61      val file = OS.Path.file f
62      val pd = !PolyML.Compiler.printDepth
63  in
64    PolyML.print_depth 0;
65    ((if List.exists (fn f => f = file) redirected_files then
66        quse (Systeml.HOLDIR ++ "tools-poly" ++ "poly" ++ "redirects" ++ file)
67      else
68        quse f)
69     handle e => (PolyML.print_depth pd; raise e));
70    PolyML.print_depth pd
71  end handle OS.Path.Path => die ("Path exception in myuse "^f)
72
73val loadPath : string list ref = ref [OS.Path.concat(HOLDIR, "sigobj")];
74
75val loadedMods = ref (Binaryset.empty String.compare);
76val _ =
77    loadedMods := Binaryset.addList (!loadedMods,
78              ["Real", "Int", "List", "Binaryset", "Binarymap", "Listsort",
79               "Array", "Array2", "Vector"])
80
81fun findUo modPath [] = NONE
82  | findUo modPath (search::rest) =
83      let val path =
84         OS.Path.mkAbsolute
85           {path = modPath, relativeTo = OS.Path.mkAbsolute
86                                           {path=search,
87                                            relativeTo = OS.FileSys.getDir ()}};
88      in
89        if OS.FileSys.access (path, []) then
90          SOME path
91        else
92          findUo modPath rest
93      end;
94
95val _ = holpathdb.extend_db {vname = "HOLDIR", path = Systeml.HOLDIR}
96
97fun loadUo ps uo =
98  let
99    val i = TextIO.openIn uo
100    val files =
101      String.tokens (fn c => c = #"\n") (TextIO.inputAll i)
102    val _ = TextIO.closeIn i
103    fun str f = ">" ^ f ^ "< -- " ^ String.concatWith " -- " ps
104    fun loadOne f =
105      (case OS.Path.ext f of
106         SOME "sml" => myuse (holpathdb.subst_pathvars f)
107       | SOME "sig" => myuse (holpathdb.subst_pathvars f)
108       | _ => load (uo::ps) f)
109      handle
110        OS.Path.InvalidArc => die ("Invalid arc exception in loading "^str f)
111      | OS.Path.Path => die ("Path exception in loading "^str f)
112      | OS.SysErr(msg,_) => die ("System error '"^msg^"' in loading "^str f)
113  in
114    List.app loadOne files
115  end
116and load ps modPath =
117  let
118    val _ = MDBG (fn _ => "Call load " ^ modPath)
119    val modPath = holpathdb.subst_pathvars modPath
120    val modName = OS.Path.file modPath
121    fun l ext =
122      case findUo (modPath ^ ext) ("."::(!loadPath)) of
123          NONE => die ("Cannot find file " ^ modPath ^ ext)
124        | SOME uo => loadUo ps uo
125  in
126    if Binaryset.member (!loadedMods, modName) then
127      ()
128    else
129      (loadedMods := Binaryset.add (!loadedMods, modName);
130       (l ".ui"; l ".uo")
131       handle e =>
132              (loadedMods := Binaryset.delete (!loadedMods, modName);
133               raise e))
134  end handle e => (TextIO.output(TextIO.stdErr,
135                                 "error in load " ^ modPath ^ " : " ^
136                                 General.exnMessage e ^ "\n");
137                   TextIO.flushOut TextIO.stdErr;
138                   raise e)
139in
140
141  structure Meta = struct
142    val meta_debug = meta_debug
143    val load = load []
144    val loadPath = loadPath;
145    fun loaded () = Binaryset.listItems (!loadedMods);
146    fun fakeload s =
147        loadedMods := Binaryset.add(!loadedMods,s)
148    fun findMod modname = findUo (modname ^ ".uo") ("." :: !loadPath)
149    fun fileDirMap () = !loadpathdb
150  end;
151
152open Meta;
153
154end;
155
156
157structure PolyWord8 = Word8;
158(* awfulness to make the environment look like Moscow ML's *)
159
160(* In Poly/ML "before" is 'a * 'b -> 'a and General.before is 'a * unit -> 'a.
161   The Basis library says both should be 'a * unit -> 'a, but in Moscow ML,
162   before is 'a * 'b -> 'a too.  Ick. *)
163
164structure Word8 = struct
165  open PolyWord8;
166  fun toLargeWord w =
167    Word.fromLargeWord (PolyWord8.toLargeWord w);
168end;
169
170structure Path = OS.Path;
171structure Process = OS.Process;
172structure FileSys = OS.FileSys;
173
174exception Interrupt = SML90.Interrupt;
175exception Io = IO.Io;
176exception SysErr = OS.SysErr;
177