Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/compiler/MiscUtil/print/pptable.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/MiscUtil/print/pptable.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1344 - (view) (download)

1 : monnier 245 (* Copyright 1992 by AT&T Bell Laboratories *)
2 :     (* pptable.sml *)
3 :    
4 :     signature PPTABLE =
5 :     sig
6 :     exception PP_NOT_INSTALLED
7 : macqueen 1344 val pp_object : PrettyPrint.stream -> Stamps.stamp -> Unsafe.Object.object
8 : monnier 245 -> unit
9 :     val install_pp : string list ->
10 : macqueen 1344 (PrettyPrint.stream -> Unsafe.Object.object -> unit) -> unit
11 : monnier 245 end
12 :    
13 :     structure PPTable : PPTABLE =
14 :     struct
15 :    
16 :     (* The following code implements automatic prettyprinting of values. *)
17 :     (* The user defines a datatype d, then defines a prettyprinter *)
18 :     (* *)
19 :     (* dp : ppstream -> d -> unit *)
20 :     (* *)
21 :     (* over d, perhaps using the Oppen primitives. Then dp is installed *)
22 :     (* in the "pp table" via install_pp. Subsequently, when a value of *)
23 :     (* type d comes to be printed out, we look in the table, find dp and *)
24 :     (* apply it to the value. If it is not found, we print the value in *)
25 :     (* the default manner. *)
26 :    
27 :     type object = Unsafe.Object.object
28 :    
29 :     exception PP_NOT_INSTALLED
30 :    
31 :     fun error msg =
32 :     (ErrorMsg.errorNoFile (ErrorMsg.defaultConsumer(),ref false) (0,0)
33 :     ErrorMsg.COMPLAIN
34 :     msg
35 :     ErrorMsg.nullErrorBody;
36 :     raise ErrorMsg.Error)
37 :    
38 : blume 587 local
39 :     val global_pp_table = ref StampMap.empty
40 :     in
41 : monnier 245
42 :     fun make_path([s],p) = SymPath.SPATH(rev(Symbol.tycSymbol(s)::p))
43 :     | make_path(s::r,p) = make_path(r,Symbol.strSymbol(s)::p)
44 :     | make_path _ = error "install_pp: empty path"
45 :    
46 :     fun install_pp (path_names: string list)
47 : macqueen 1344 (p: PrettyPrint.stream -> object -> unit) =
48 : monnier 245 let val sym_path = make_path(path_names,[])
49 :     val tycon = Lookup.lookTyc ((#static(EnvRef.combined())),
50 :     sym_path,
51 :     ErrorMsg.errorNoFile(ErrorMsg.defaultConsumer(),ref false) (0,0))
52 :     in case tycon
53 : blume 587 of Types.GENtyc { stamp, ... } =>
54 :     global_pp_table := StampMap.insert (!global_pp_table, stamp, p)
55 : monnier 245 | _ => error "install_pp: nongenerative type constructor"
56 :     end
57 :    
58 :     fun pp_object ppstrm (s: Stamps.stamp) (obj:object) =
59 : blume 587 case StampMap.find (!global_pp_table, s) of
60 :     SOME p => p ppstrm obj
61 :     | NONE => raise PP_NOT_INSTALLED
62 : monnier 245
63 : blume 587 end
64 :    
65 : monnier 245 end (* structure PPTABLE *)
66 :    

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0