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

Annotation of /sml/trunk/src/compiler/PervEnv/Basis/exn-name.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 90 - (view) (download)
Original Path: sml/branches/FLINT/src/compiler/PervEnv/Basis/exn-name.sml

1 : monnier 89 (* 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 :     structure ExnName : sig
11 :    
12 :     val exnName : exn -> string
13 :     val exnMessage : exn -> string
14 :    
15 :     end = struct
16 :    
17 :     val string_tag = 0x2a
18 :    
19 :     (* Normal exception names are strings; debugger exception names
20 :     * are pairs of the form string * int.
21 :     *)
22 :     fun normalExnName (x : Assembly.object) = (InlineT.gettag x = string_tag)
23 :    
24 :     val exnName : exn -> string = InlineT.cast(
25 :     fn (ref s, _,_) => if normalExnName (InlineT.cast s)
26 :     then s
27 :     else let val (s,_) = InlineT.cast s in s end)
28 :    
29 :     fun exnMessage (OS.SysErr(s, NONE)) =
30 :     "SysErr: " ^ s
31 :     | exnMessage (OS.SysErr(s, SOME e)) =
32 :     concat["SysErr: ", s, " [", OS.errorName e, "]"]
33 :     | exnMessage (IO.Io{cause, function, name}) = let
34 :     val causeMsg = (case cause
35 :     of (OS.SysErr(s, _)) => [", ", s]
36 :     | IO.BlockingNotSupported => [", blocking I/O not supported"]
37 :     | IO.NonblockingNotSupported =>
38 :     [", non-blocking I/O not supported"]
39 :     | IO.RandomAccessNotSupported => [", random access not supported"]
40 :     | IO.TerminatedStream => [", terminated input stream"]
41 :     | IO.ClosedStream => [", closed stream"]
42 :     | _ => [" with exception ", exnMessage cause]
43 :     (* end case *))
44 :     in
45 :     concat("Io: " :: function :: " failed on \"" :: name :: "\"" :: causeMsg)
46 :     end
47 :     | exnMessage (Fail s) = "Fail: " ^ s
48 :     (** NOTE: we should probably include line/file info for Match and Bind *)
49 :     | exnMessage Bind = "nonexhaustive binding failure"
50 :     | exnMessage Match = "nonexhaustive match failure"
51 :     | exnMessage Subscript = "subscript out of bounds"
52 :     | exnMessage Size = "size"
53 :     | exnMessage Overflow = "overflow"
54 :     | exnMessage Div = "divide by zero"
55 :     | exnMessage Domain = "domain error"
56 :     | exnMessage e = exnName e
57 :    
58 :     end
59 :    
60 :     (*
61 :     * $Log: exn-name.sml,v $
62 :     * Revision 1.1.1.1 1998/04/08 18:40:03 george
63 :     * Version 110.5
64 :     *
65 :     *)

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