1(*
2    Title:      PolyML.Exception structure
3    Author:     David C. J. Matthews
4    Copyright (c) 2015
5
6    This library is free software; you can redistribute it and/or
7    modify it under the terms of the GNU Lesser General Public
8    License version 2.1 as published by the Free Software Foundation.
9
10    This library is distributed in the hope that it will be useful,
11    but WITHOUT ANY WARRANTY; without even the implied warranty of
12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
13    Lesser General Public License for more details.
14
15    You should have received a copy of the GNU Lesser General Public
16    License along with this library; if not, write to the Free Software
17    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
18*)
19
20(* Add PolyML.Exception to the PolyML structure. *)
21(* N.B. The effect of compiling this file is to extend the PolyML structure. *)
22
23structure PolyML =
24struct
25    open PolyML
26
27    local
28        (* This datatype is used in VALUE_OPS and FinalPolyML to define the format of a
29           location in an exception packet.  It includes the possibility that the location
30                   information may be missing. *)
31        datatype RuntimeLocation =
32            NoLocation
33        |   SomeLocation of
34                (* file: *) string *
35                (*startLine:*) FixedInt.int *  (*startPosition:*) FixedInt.int *
36                (*endLine:*) FixedInt.int * (*endPosition:*) FixedInt.int
37    in
38        structure Exception =
39        struct
40            (* Backwards compatibility. *)
41            fun traceException(f: unit->'a, _: string list * exn -> 'a): 'a = f()
42
43            fun exceptionLocation(exn: exn): location option =
44                case RunCall.loadWordFromImmutable(exn, 0w3) of
45                    NoLocation => NONE
46                |   SomeLocation(file, startLine, startPosition, endLine, endPosition) =>
47                        SOME { file=file, startLine=startLine, startPosition=startPosition,
48                               endLine=endLine, endPosition=endPosition }
49
50            local
51                (* If we use ML "raise" to raise an exception the location will be the
52                   location of the raise.  If we have a handler that reraises an exception
53                   it is often better to preserve the original location.  We need to add
54                   a function that raises an exception without adding its own location. *)
55                open PolyML.CodeTree
56                val functionCode = mkFunction (mkRaise(mkLoadArgument 0), 1, "raiseFn", [], 0)
57                (* N.B. genCode is redefined in FinalPolyML without the options argument. *)
58                val compiledCode = genCode(functionCode, [], 0) ()
59                val raiseFn = case evalue compiledCode of SOME c => c | NONE => raise Bind
60            in
61                (* Raise an exception using a given location rather than the value in the packet. *)
62                fun raiseWithLocation(ex: exn, {file, startLine, startPosition, endLine, endPosition}: location) =
63                let
64                    open RunCall
65                    fun getEntry n = RunCall.loadWordFromImmutable(ex, n)
66                    val packet =
67                        (getEntry 0w0, getEntry 0w1, getEntry 0w2,
68                            SomeLocation(file, startLine, startPosition, endLine, endPosition))
69                in
70                    RunCall.unsafeCast raiseFn packet
71                end
72            end
73
74            (* Re-raise an exception that has been handled preserving the location. *)
75            fun reraise exn =
76                case exceptionLocation exn of
77                    NONE => raise exn
78                |   SOME location => raiseWithLocation (exn, location)
79        end
80    end
81
82    (* For backwards compatibility include these in the PolyML structure. *)
83    val exceptionLocation = Exception.exceptionLocation
84    and raiseWithLocation = Exception.raiseWithLocation
85end;
86