home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / examples / helpsigs / Database.sml < prev    next >
Encoding:
Text File  |  1997-08-18  |  1.8 KB  |  63 lines  |  [TEXT/R*ch]
  1. (* Database.sml *)
  2.  
  3. datatype component = 
  4.     Str                    (* structure                       *)
  5.   | Exc of string            (* exception constructor with name *)
  6.   | Typ of string            (* type constructor with name      *)
  7.   | Val of string            (* value with name                 *)
  8.   | Con of string            (* value constructor with name       *)
  9.  
  10. (* An entry consist of a component and the name of its structure: *)
  11.  
  12. type entry = { comp : component, str : string, line : int }
  13.  
  14. (* Table represented by ordered binary tree, where key is lowercase: *)
  15.  
  16. datatype 'contents table =
  17.     Empty
  18.   | Node of string * 'contents * 'contents table * 'contents table
  19.  
  20. (* The database is a table of sorted lists of entries: *)
  21.  
  22. type database = entry list table
  23.  
  24. fun writebase(filename, db) =
  25.     let val os = BasicIO.open_out_bin filename
  26.     in Nonstdio.output_value os db; BasicIO.close_out os end
  27.  
  28. fun readbase filename =
  29.     let open BasicIO
  30.     prim_type in_channel 
  31.     type instream_  = { closed: bool, ic: in_channel } ref
  32.     prim_val input_value_ : in_channel -> 'a = 1 "intern_val"
  33.     prim_val fromI : instream -> instream_   = 1 "identity"
  34.         fun input_value is =
  35.         let val ref {closed, ic} = fromI is in
  36.         if closed then
  37.             raise SysErr("Input stream is closed", NONE)
  38.         else
  39.             input_value_ ic
  40.         end
  41.     val is = open_in_bin filename
  42.     val db = input_value is : database
  43.     in close_in is; db end
  44.  
  45. fun lookup(db : database, sought : string) =
  46.     let fun look Empty                      = []
  47.       | look (Node(key, value, t1, t2)) =
  48.         if sought < key then look t1
  49.         else if key < sought then look t2
  50.         else value
  51.     in look db end
  52.  
  53. (* Extract the name from an entry: *)
  54.  
  55. fun getname ({comp, str, ...} : entry) =
  56.     case comp of
  57.     Str    => str
  58.       | Exc id => id
  59.       | Typ id => id
  60.       | Val id => id
  61.       | Con id => id
  62.  
  63.