diff --git a/basis/ExnPrinter.sml b/basis/ExnPrinter.sml index 706a2d5f..c04418dc 100644 --- a/basis/ExnPrinter.sml +++ b/basis/ExnPrinter.sml @@ -1,122 +1,122 @@ (* Title: Install a pretty printer for the exn type Author: David Matthews - Copyright David Matthews 2009, 2016 + Copyright David Matthews 2009, 2016, 2019 This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) local open PolyML (* Print exception packet. Run-time system exceptions have to be processed specially because the IDs don't have printer functions. *) fun exnPrint depth _ exn = let val (exnId, exnName, exnArg, _) = RunCall.unsafeCast exn (* This parenthesis code is used in various places and probably should be centralised. *) fun parenthesise(s as PrettyBlock(_, _, _, [ _ ])) = s | parenthesise(s as PrettyBlock(_, _, _, (PrettyString("(")::_ ))) = s | parenthesise(s as PrettyBlock(_, _, _, (PrettyString("{")::_ ))) = s | parenthesise(s as PrettyBlock(_, _, _, (PrettyString("[")::_ ))) = s | parenthesise(s as PrettyBlock _) = PrettyBlock(3, true, [], [ PrettyString "(", s, PrettyString ")" ]) | parenthesise s = s (* String or Break *) fun nullaryException s = PrettyString s and parameterException(s, param) = PrettyBlock(1, false, [], [ PrettyString s, PrettyBreak(1, 1), parenthesise param ]) (* Use prettyRepresentation because this correctly quotes the string. *) fun stringException(s, arg: string) = parameterException(s, PolyML.prettyRepresentation(arg, depth-1)) in if RunCall.isShort exnId then case exn of RunCall.Conversion s => stringException(exnName, s) | Fail s => stringException(exnName, s) | RunCall.Foreign s => stringException(exnName, s) | RunCall.Thread s => stringException(exnName, s) | RunCall.XWindows s => stringException(exnName, s) - | OS.SysErr param => + | LibrarySupport.SysErr param => parameterException("SysErr", if depth <= 1 then PrettyString "..." else PolyML.prettyRepresentation(param, depth-1)) | _ => (* Anything else is nullary. *) nullaryException exnName else ( (* Exceptions generated within ML contain a printer function. *) case !exnId of NONE => nullaryException exnName | SOME printFn => parameterException(exnName, printFn(exnArg, depth-1)) ) end in val () = addPrettyPrinter exnPrint end; (* Print a ref. Because refs can form circular structures we include a check for a loop here. *) local open PolyML (* If we have an expression as the argument we parenthesise it unless it is a simple string, a tuple, a record or a list. *) fun parenthesise(s as PrettyBlock(_, _, _, [ _ ])) = s | parenthesise(s as PrettyBlock(_, _, _, (PrettyString("(")::_ ))) = s | parenthesise(s as PrettyBlock(_, _, _, (PrettyString("{")::_ ))) = s | parenthesise(s as PrettyBlock(_, _, _, (PrettyString("[")::_ ))) = s | parenthesise(s as PrettyBlock _) = PrettyBlock(3, true, [], [ PrettyString "(", s, PrettyString ")" ]) | parenthesise s = s (* String or Break *) val printLimit: word ref list Universal.tag = Universal.tag() fun print_ref depth doArg (r as ref x) = if depth <= 0 then PrettyString "..." else let (* We keep a list in thread-local storage of refs we're currently printing. This is thread-local to avoid interference between different threads. *) val currentRefs = case Thread.Thread.getLocal printLimit of NONE => [] | SOME limit => limit val thisRef: word ref = RunCall.unsafeCast r in if List.exists(fn x => x = thisRef) currentRefs then PrettyString "..." (* We've already seen this ref. *) else ( (* Add this to the list. *) Thread.Thread.setLocal (printLimit, thisRef :: currentRefs); (* Print it and reset the list*) (PrettyBlock(3, false, [], [ PrettyString "ref", PrettyBreak(1, 0), parenthesise(doArg(x, depth-1)) ])) before (Thread.Thread.setLocal (printLimit, currentRefs)) ) handle exn => ( (* Reset the list if there's been an exception. *) Thread.Thread.setLocal (printLimit, currentRefs); raise exn ) end in val () = addPrettyPrinter print_ref end; diff --git a/basis/build.sml b/basis/build.sml index 676add7d..f01f972e 100644 --- a/basis/build.sml +++ b/basis/build.sml @@ -1,183 +1,183 @@ (* Title: Standard Basis Library: Commands to build the library Copyright David C.J. Matthews 2000, 2005, 2015-16, 2018-19 This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) (* Thread, Weak and Signal are Poly/ML extensions. *) val () = Bootstrap.use "basis/InitialBasis.ML"; val () = Bootstrap.use "basis/Universal.ML"; val () = Bootstrap.use "basis/General.sml"; val () = Bootstrap.use "basis/LibrarySupport.sml"; val () = Bootstrap.use "basis/PolyMLException.sml"; val () = Bootstrap.use "basis/Option.sml"; val () = Bootstrap.use "basis/ListSignature.sml"; val () = Bootstrap.use "basis/List.sml"; val () = Bootstrap.use "basis/VectorOperations.sml"; val () = Bootstrap.use "basis/PolyVectorOperations.sml"; val () = Bootstrap.use "basis/VectorSliceOperations.sml"; val () = Bootstrap.use "basis/MONO_VECTOR.sml"; val () = Bootstrap.use "basis/MONO_VECTOR_SLICE.sml"; val () = Bootstrap.use "basis/MONO_ARRAY.sml"; val () = Bootstrap.use "basis/MONO_ARRAY_SLICE.sml"; val () = Bootstrap.use "basis/StringSignatures.sml"; val () = Bootstrap.use "basis/String.sml"; structure Int = struct type int = int end; val () = Bootstrap.use "basis/INTEGER.sml"; val () = Bootstrap.use "basis/Int.sml"; val () = Bootstrap.use (if Bootstrap.intIsArbitraryPrecision then "basis/IntAsLargeInt.sml" else "basis/IntAsFixedInt.sml"); val () = case FixedInt.precision of SOME 31 => Bootstrap.use "basis/Int31.sml" | SOME 63 => Bootstrap.use "basis/Int63.sml" | _ => (); val () = Bootstrap.use "basis/WordSignature.sml"; val () = Bootstrap.use "basis/LargeWord.sml"; val () = Bootstrap.use "basis/VectorSignature.sml"; val () = Bootstrap.use "basis/VectorSliceSignature.sml"; val () = Bootstrap.use "basis/Vector.sml"; val () = Bootstrap.use "basis/ArraySignature.sml"; val () = Bootstrap.use "basis/ArraySliceSignature.sml"; (* Depends on VectorSlice. *) val () = Bootstrap.use "basis/Array.sml"; val () = Bootstrap.use "basis/Text.sml"; (* Declares Char, String, CharArray, CharVector *) val () = Bootstrap.use "basis/Bool.sml"; val () = Bootstrap.use "basis/ListPair.sml"; (* Declare the appropriate additional structures. *) (* The version of Word32 we use depends on whether this is 32-bit or 64-bit. *) val () = if LargeWord.wordSize = 32 then Bootstrap.use "basis/Word32.sml" else if Word.wordSize >= 32 then Bootstrap.use "basis/Word32In64.sml" else if LargeWord.wordSize = 64 then Bootstrap.use "basis/Word32InLargeWord64.sml" else (); val () = Bootstrap.use "basis/Word16.sml"; val () = Bootstrap.use "basis/Word8.sml"; val () = Bootstrap.use "basis/IntInf.sml"; val () = Bootstrap.use "basis/Int32.sml"; val () = Bootstrap.use "basis/Word8Array.sml"; val () = Bootstrap.use "basis/Byte.sml"; val () = Bootstrap.use "basis/BoolArray.sml"; val () = Bootstrap.use "basis/IntArray.sml"; val () = Bootstrap.use "basis/RealArray.sml"; val () = Bootstrap.use "basis/IEEE_REAL.sml"; val () = Bootstrap.use "basis/IEEEReal.sml"; val () = Bootstrap.use "basis/MATH.sml"; val () = Bootstrap.use "basis/MATH.sml"; structure LargeReal = struct type real = real end; val () = Bootstrap.use "basis/RealSignature.sml"; val () = Bootstrap.use "basis/Real.sml"; val () = Bootstrap.use "basis/Real32.sml"; val () = Bootstrap.use "basis/Time.sml"; val () = Bootstrap.use "basis/DateSignature.sml"; val () = Bootstrap.use "basis/Date.sml"; val () = Bootstrap.use "basis/Thread.sml"; (* Non-standard. *) val () = Bootstrap.use "basis/Timer.sml"; val () = Bootstrap.use "basis/CommandLine.sml"; val () = Bootstrap.use "basis/OS.sml"; -val () = Bootstrap.use "basis/ExnPrinter.sml"; (* Relies on OS. *) +val () = Bootstrap.use "basis/ExnPrinter.sml"; val () = Bootstrap.use "basis/InitialPolyML.ML"; (* Relies on OS. *) val () = Bootstrap.use "basis/ForeignConstants.sml"; val () = Bootstrap.use "basis/ForeignMemory.sml"; val () = Bootstrap.useWithParms [Bootstrap.Universal.tagInject Bootstrap.maxInlineSizeTag 1000] "basis/Foreign.sml"; val () = Bootstrap.use "basis/IO.sml"; val () = Bootstrap.use "basis/PRIM_IO.sml"; val () = Bootstrap.use "basis/PrimIO.sml"; (*val () = Bootstrap.use "basis/TextPrimIO.sml"; val () = Bootstrap.use "basis/BinPrimIO.sml"; *) val () = Bootstrap.use "basis/LibraryIOSupport.sml"; val () = Bootstrap.use "basis/STREAM_IO.sml"; val () = Bootstrap.use "basis/BasicStreamIO.sml"; val () = Bootstrap.use "basis/IMPERATIVE_IO.sml"; val () = Bootstrap.use "basis/ImperativeIO.sml"; val () = Bootstrap.use "basis/TextIO.sml"; val () = Bootstrap.use "basis/BinIO.sml"; val () = Bootstrap.use "basis/Socket.sml"; val () = Bootstrap.use "basis/NetProtDB.sml"; val () = Bootstrap.use "basis/NetServDB.sml"; val () = Bootstrap.use "basis/GenericSock.sml"; val () = Bootstrap.use "basis/INetSock.sml"; val () = Bootstrap.use "basis/INet6Sock.sml"; val () = Bootstrap.use "basis/UnixSock.sml"; val () = Bootstrap.use "basis/PackRealBig.sml"; (* also declares PackRealLittle *) val () = Bootstrap.use "basis/PackWord8Big.sml"; (* also declares Pack8Little. ...*) val () = Bootstrap.use "basis/Array2Signature.sml"; val () = Bootstrap.use "basis/Array2.sml"; val () = Bootstrap.use "basis/IntArray2.sml"; val () = Bootstrap.use "basis/SML90.sml"; val () = Bootstrap.use "basis/Weak.sml"; val () = Bootstrap.use "basis/Signal.sml"; val () = Bootstrap.use "basis/BIT_FLAGS.sml"; val () = Bootstrap.use "basis/SingleAssignment.sml"; (* Build Windows or Unix structure as appropriate. *) local val getOS: int = LibrarySupport.getOSType() in val () = if getOS = 0 then ( Bootstrap.use "basis/Posix.sml"; Bootstrap.use "basis/Unix.sml") else if getOS = 1 then (Bootstrap.use "basis/Windows.sml") else () end; val () = Bootstrap.use "basis/HashArray.ML"; val () = Bootstrap.use "basis/UniversalArray.ML"; val () = Bootstrap.use "basis/PrettyPrinter.sml"; (* Add PrettyPrinter to PolyML structure. *) val () = Bootstrap.use "basis/ASN1.sml"; val () = Bootstrap.use "basis/Statistics.ML"; (* Add Statistics to PolyML structure. *) val () = Bootstrap.use "basis/FinalPolyML.sml"; val () = Bootstrap.use "basis/TopLevelPolyML.sml"; (* Add rootFunction to Poly/ML. *) val use = PolyML.use; (* Copy everything out of the original name space. *) (* Do this AFTER we've finished compiling PolyML and after adding "use". *) val () = List.app (#enterVal PolyML.globalNameSpace) (#allVal Bootstrap.globalSpace ()) and () = List.app (#enterFix PolyML.globalNameSpace) (#allFix Bootstrap.globalSpace ()) and () = List.app (#enterSig PolyML.globalNameSpace) (#allSig Bootstrap.globalSpace ()) and () = List.app (#enterType PolyML.globalNameSpace) (#allType Bootstrap.globalSpace ()) and () = List.app (#enterFunct PolyML.globalNameSpace) (#allFunct Bootstrap.globalSpace ()) and () = List.app (#enterStruct PolyML.globalNameSpace) (#allStruct Bootstrap.globalSpace ()) (* We don't want Bootstrap copied over. *) val () = PolyML.Compiler.forgetStructure "Bootstrap"; (* Clean out structures and functors which are only used to build the library. *) PolyML.Compiler.forgetValue "it"; PolyML.Compiler.forgetStructure "LibrarySupport"; PolyML.Compiler.forgetStructure "LibraryIOSupport"; PolyML.Compiler.forgetStructure "MachineConstants"; PolyML.Compiler.forgetStructure "ForeignConstants"; PolyML.Compiler.forgetStructure "ForeignMemory"; PolyML.Compiler.forgetFunctor "BasicStreamIO"; PolyML.Compiler.forgetFunctor "VectorOperations"; PolyML.Compiler.forgetFunctor "PolyVectorOperations"; PolyML.Compiler.forgetFunctor "VectorSliceOperations"; PolyML.Compiler.forgetFunctor "BasicImperativeIO"; PolyML.Compiler.forgetFunctor "ASN1"; PolyML.Compiler.forgetSignature "ASN1"; (* Now we've created the new name space we must use PolyML.make/use. N.B. Unlike Bootstrap.use these don't automatically look at the -I option. *)