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/system/Basis/Implementation/exn-name.sml
ViewVC logotype

Annotation of /sml/trunk/src/system/Basis/Implementation/exn-name.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 939 - (view) (download)

1 : monnier 416 (* exn-name.sml
2 :     *
3 :     * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
4 :     *
5 :     * Eventually, this should move to PreBasis so that we don't need the PreGeneral
6 :     * structure anymore.
7 :     *
8 :     *)
9 :    
10 :     local
11 :     structure OS = OSImp
12 :     in
13 :     structure ExnName : sig
14 :    
15 :     val exnName : exn -> string
16 :     val exnMessage : exn -> string
17 :    
18 :     end = struct
19 :    
20 : blume 939 val exnName : exn -> string = ExnInfoHook.exnName (* InlineT.cast(fn (ref s, _,_) => s) *)
21 : monnier 416
22 :     fun exnMessage (OS.SysErr(s, NONE)) =
23 :     "SysErr: " ^ s
24 :     | exnMessage (OS.SysErr(s, SOME e)) =
25 :     concat["SysErr: ", s, " [", OS.errorName e, "]"]
26 :     | exnMessage (IO.Io{cause, function, name}) = let
27 :     val causeMsg = (case cause
28 :     of (OS.SysErr(s, _)) => [", ", s]
29 :     | IO.BlockingNotSupported => [", blocking I/O not supported"]
30 :     | IO.NonblockingNotSupported =>
31 :     [", non-blocking I/O not supported"]
32 :     | IO.RandomAccessNotSupported => [", random access not supported"]
33 :     | IO.TerminatedStream => [", terminated input stream"]
34 :     | IO.ClosedStream => [", closed stream"]
35 :     | _ => [" with exception ", exnMessage cause]
36 :     (* end case *))
37 :     in
38 :     concat("Io: " :: function :: " failed on \"" :: name :: "\"" :: causeMsg)
39 :     end
40 :     | exnMessage (Fail s) = "Fail: " ^ s
41 :     (** NOTE: we should probably include line/file info for Match and Bind *)
42 :     | exnMessage Bind = "nonexhaustive binding failure"
43 :     | exnMessage Match = "nonexhaustive match failure"
44 :     | exnMessage Subscript = "subscript out of bounds"
45 :     | exnMessage Size = "size"
46 :     | exnMessage Overflow = "overflow"
47 :     | exnMessage Div = "divide by zero"
48 :     | exnMessage Domain = "domain error"
49 :     | exnMessage e = exnName e
50 :    
51 :     val _ = ExnInfoHook.exnMessageHook := exnMessage
52 :    
53 :     end
54 :     end
55 :    

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