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