1(* Parsspec -- parse Moscow ML signature files. 2 3*) 4 5structure Parsspec = struct 6 7open List 8 9structure SMLLrVals = 10 SMLLrValsFun(structure Token = LrParser.Token); 11structure SMLLex = 12 SMLLexFun(structure Tokens = SMLLrVals.Tokens); 13structure SMLParser = 14 JoinWithArg(structure ParserData = SMLLrVals.ParserData 15 structure Lex=SMLLex 16 structure LrParser=LrParser); 17 18fun parseSpec filename is = let 19 val lexer = SMLParser.makeLexer (fn n => TextIO.inputN (is, n)) 0 20 fun print_error (s,(_, i:int),_) = 21 TextIO.output(TextIO.stdErr, filename^":"^Int.toString (i+1) ^ ": " ^ s ^ "\n") 22in 23 #1 (SMLParser.parse(15, lexer, print_error, ())) 24end 25 26fun processSpec is str (((pos1, pos2), spec), res) = 27 let open Asynt Database 28 fun getId ({qualid = {id, ...}, ...} : IdInfo) = id 29 fun valdesc ((idInfo, ty), res) = 30 {comp = Val (getId idInfo), file = str, line = #2 pos1} :: res 31 fun pvaldesc ((idInfo, ty, arity, cfun), res) = 32 {comp = Val (getId idInfo), file = str, line = #2 pos1} :: res 33 fun typdesc ((tyvars, idInfo), res) = 34 {comp = Typ (getId idInfo), file = str, line = #2 pos1} :: res 35 fun typbind ((tyvars, idInfo, ty), res) = 36 {comp = Typ (getId idInfo), file = str, line = #2 pos1} :: res 37 fun conbind ((ConBind(idInfo, tyOpt)), res) = 38 {comp = Con (getId idInfo), file = str, line = #2 pos1} :: res 39 fun datbind ((tyvars, idInfo, cbs), res) = 40 {comp = Typ (getId idInfo), file = str, line = #2 pos1} 41 :: foldl conbind res cbs 42 fun datrep (idInfo, res) = 43 {comp = Typ (getId idInfo), file = str, line = #2 pos1} :: res 44 fun exdesc ((idInfo, tyOpt), res) = 45 {comp = Exc (getId idInfo), file = str, line = #2 pos1} :: res 46 in 47 case spec of 48 VALspec vs => foldl valdesc res vs 49 | PRIM_VALspec pvs => foldl pvaldesc res pvs 50 | TYPEDESCspec (tnEqu, tyds) => foldl typdesc res tyds 51 | TYPEspec tybs => foldl typbind res tybs 52 | DATATYPEspec (dbs, tybsOpt) => 53 foldl datbind (foldl typbind res (getOpt(tybsOpt, []))) dbs 54 | DATATYPErepspec (ty, _) => datrep (ty, res) 55 | EXCEPTIONspec eds => foldl exdesc res eds 56 | LOCALspec (spec1, spec2) => processSpec is str (spec2, res) 57 | OPENspec strs => res 58 | INCLUDEspecs strs => res 59 | INCLUDEspec sigexp => res 60 | EMPTYspec => res 61 | SEQspec (spec1, spec2) => 62 processSpec is str (spec2, processSpec is str (spec1, res)) 63 | STRUCTUREspec moddescs => res (* TODO: add link *) 64 end 65 66fun parseAndProcess dir str res = 67 let val basefile = OS.Path.joinBaseExt {base = str, ext = SOME "sig"} 68 val filename = OS.Path.joinDirFile {dir=dir, file = basefile} 69 (* val _ = print("Parsing " ^ basefile ^ " ... ") *) 70 val resLength = length res 71 val is = TextIO.openIn filename 72 val specs = case parseSpec filename is 73 of Asynt.NamedSig {specs, ...} => specs 74 | Asynt.AnonSig specs => specs; 75 val initialbase = {comp = Database.Str, file = str, line = 0} :: res 76 val res = foldl (processSpec is str) initialbase specs 77 (* val _ = print ("processed " ^ Int.toString (length res - resLength) 78 ^ " entries.\n") *) 79 in 80 TextIO.closeIn is; res 81 end 82 handle SML90.Interrupt => raise SML90.Interrupt 83 | _ => (print ("Failed to parse (or find?) "^str^ 84 ".sig (continuing anyway).\n"); 85 res) 86 87(* To parse the signature of unit `filename' and prepend the 88 * entries to the list res: 89 *) 90 91fun processfile stoplist dir (filename, res) = 92 let val {base, ext} = OS.Path.splitBaseExt filename 93 in 94 case ext of 95 SOME "sig" => 96 if List.exists (fn name => base = name) stoplist then 97 res 98 else 99 parseAndProcess dir base res 100 | _ => res 101 end 102end 103