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