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