20200703 src/JSON (update auf SML/NJ 110.97)

src/JSON/json-lib.cm

@@ -22,7 +22,12 @@ is
   $/smlnj-lib.cm
   $/ml-lpt-lib.cm
 
+#if defined(NO_PLUGINS)
+  json.lex.sml
+#else
   json.lex : ml-ulex
+#endif
+
   json.sml
   json-parser.sml
   json-printer.sml
@@ -30,4 +35,3 @@ is
   json-stream-printer.sml
   json-tokens.sml
   json-util.sml
-

src/JSON/json-stream-parser.sml

@@ -1,6 +1,6 @@
 (* json-stream-parser.sml
  *
- * COPYRIGHT (c) 2008 The Fellowship of SML/NJ (http://www.smlnj.org)
+ * COPYRIGHT (c) 2020 The Fellowship of SML/NJ (http://www.smlnj.org)
  * All rights reserved.
  *)
 
@@ -18,7 +18,7 @@ structure JSONStreamParser : sig
 	endObject : 'ctx -> 'ctx,
 	startArray : 'ctx -> 'ctx,
 	endArray : 'ctx -> 'ctx,
-	error : 'ctx * string -> 'ctx
+	error : 'ctx * string -> unit
       }
 
     val parse : 'ctx callbacks -> (TextIO.instream * 'ctx) -> 'ctx
@@ -42,7 +42,7 @@ structure JSONStreamParser : sig
 	endObject : 'ctx -> 'ctx,
 	startArray : 'ctx -> 'ctx,
 	endArray : 'ctx -> 'ctx,
-	error : 'ctx * string -> 'ctx
+	error : 'ctx * string -> unit
       }
 
     fun error (cb : 'a callbacks, ctx, msg) = (

src/JSON/json-stream-printer.sml

@@ -1,6 +1,6 @@
 (* json-stream-printer.sml
  *
- * COPYRIGHT (c) 2008 The Fellowship of SML/NJ (http://www.smlnj.org)
+ * COPYRIGHT (c) 2020 The Fellowship of SML/NJ (http://www.smlnj.org)
  * All rights reserved.
  *)
 
@@ -38,7 +38,8 @@ structure JSONStreamPrinter : sig
    * and punctuation, etc.
    *)
     and context
-      = TOP			(* top-most context *)
+      = CLOSED			(* closed printer *)
+      | TOP			(* top-most context *)
       | FIRST of context	(* first element of object or array; the argument *)
 				(* must be one of OBJECT or ARRAY. *)
       | OBJECT of context	(* in an object (after the first element) *)
@@ -54,8 +55,11 @@ structure JSONStreamPrinter : sig
 
     fun new strm = new' {strm = strm, pretty = false}
 
-    fun close (P{ctx = ref TOP, strm, ...}) = TextIO.output(strm, "\n")
-      | close _ = raise Fail "premature close"
+    fun close (P{ctx, strm, ...}) = (case !ctx
+	   of CLOSED => ()
+	    | TOP => (TextIO.output(strm, "\n"); ctx := CLOSED)
+	    | _ => raise Fail "premature close"
+	  (* end case *))
 
     fun pr (P{strm, ...}, s) = TextIO.output(strm, s)
 
@@ -90,7 +94,8 @@ structure JSONStreamPrinter : sig
 	  (* end case *))
 
   (* print a value, which may be proceeded by a comma if it is in a sequence *)
-    fun prVal (p, v) = (optComma p; pr(p, v))
+    fun prVal (P{ctx = ref CLOSED, ...}, _) = raise Fail "closed printer"
+      | prVal (p, v) = (optComma p; pr(p, v))
 
     fun null p = prVal (p, "null")
     fun boolean (p, false) = prVal (p, "false")
@@ -122,16 +127,23 @@ structure JSONStreamPrinter : sig
 	    prVal (p, F.format "\"%s\"" [F.STR(tr (0, []))])
 	  end
 
-    fun beginObject (p as P{ctx, ...}) = (
-	  optComma p;
-	  pr (p, "{"); incIndent(p, 1); nl p;
-	  ctx := FIRST(OBJECT(!ctx)))
+    fun beginObject (p as P{ctx, ...}) = (case !ctx
+	   of CLOSED => raise Fail "closed printer"
+	    | _ => (
+		optComma p;
+		pr (p, "{"); incIndent(p, 1); nl p;
+		ctx := FIRST(OBJECT(!ctx)))
+	  (* end case *))
 
-    fun objectKey (p as P{ctx = ref(KEY _), ...}, field) =
-	  raise Fail(concat["objectKey \"", field, "\" where value was expected"])
-      | objectKey (p as P{ctx, ...}, field) = (
-	  string (p, field);
-	  ctx := KEY(!ctx))
+    fun objectKey (p as P{ctx, ...}, field) = (case !ctx
+	   of CLOSED => raise Fail "closed printer"
+	    | KEY _ => raise Fail(concat[
+		  "objectKey \"", field, "\" where value was expected"
+		])
+	    | _ => (
+		string (p, field);
+		ctx := KEY(!ctx))
+	  (* end case *))
 
     fun endObject (p as P{ctx, ...}) = let
 	  fun prEnd ctx' = (
@@ -139,16 +151,21 @@ structure JSONStreamPrinter : sig
 		decIndent (p, 1); indent(p, 0); pr(p, "}"))
 	  in
 	    case !ctx
-	     of OBJECT ctx' => (nl p; prEnd ctx')
+	     of CLOSED => raise Fail "closed printer"
+	      | OBJECT ctx' => (nl p; prEnd ctx')
 	      | FIRST(OBJECT ctx') => prEnd ctx'
+	      | KEY _ => raise Fail "expecting value after key"
 	      | _ => raise Fail "endObject not in object context"
 	    (* end case *)
 	  end
 
-    fun beginArray (p as P{ctx, ...}) = (
-	  optComma p;
-	  pr (p, "["); incIndent(p, 1); nl p;
-	  ctx := FIRST(ARRAY(!ctx)))
+    fun beginArray (p as P{ctx, ...}) = (case !ctx
+	   of CLOSED => raise Fail "closed printer"
+	    | _ => (
+		optComma p;
+		pr (p, "["); incIndent(p, 1); nl p;
+		ctx := FIRST(ARRAY(!ctx)))
+	  (* end case *))
 
     fun endArray (p as P{ctx, ...}) = let
 	  fun prEnd ctx' = (
@@ -156,7 +173,8 @@ structure JSONStreamPrinter : sig
 		decIndent (p, 1); indent(p, 0); pr(p, "]"))
 	  in
 	    case !ctx
-	     of ARRAY ctx' => (nl p; prEnd ctx')
+	     of CLOSED => raise Fail "closed printer"
+	      | ARRAY ctx' => (nl p; prEnd ctx')
 	      | FIRST(ARRAY ctx') => prEnd ctx'
 	      | _ => raise Fail "endArray not in array context"
 	    (* end case *)

src/JSON/json-util.sml

@@ -23,7 +23,7 @@ structure JSONUtil : sig
   (* exception that is raised when trying to process a non-array value as an array *)
     exception NotArray of JSON.value
 
-  (* exception that is raise when access to an array value is out of bounds *)
+  (* exception that is raised when access to an array value is out of bounds *)
     exception ArrayBounds of JSON.value * int
 
   (* map the above exceptions to a message string; we use General.exnMessage for other

src/JSON/patch/json-stream-printer.sml.orig

@@ -1,6 +1,6 @@
 (* json-stream-printer.sml
  *
- * COPYRIGHT (c) 2008 The Fellowship of SML/NJ (http://www.smlnj.org)
+ * COPYRIGHT (c) 2020 The Fellowship of SML/NJ (http://www.smlnj.org)
  * All rights reserved.
  *)
 
@@ -38,7 +38,8 @@ structure JSONStreamPrinter : sig
    * and punctuation, etc.
    *)
     and context
-      = TOP			(* top-most context *)
+      = CLOSED			(* closed printer *)
+      | TOP			(* top-most context *)
       | FIRST of context	(* first element of object or array; the argument *)
 				(* must be one of OBJECT or ARRAY. *)
       | OBJECT of context	(* in an object (after the first element) *)
@@ -54,8 +55,11 @@ structure JSONStreamPrinter : sig
 
     fun new strm = new' {strm = strm, pretty = false}
 
-    fun close (P{ctx = ref TOP, strm, ...}) = TextIO.output(strm, "\n")
-      | close _ = raise Fail "premature close"
+    fun close (P{ctx, strm, ...}) = (case !ctx
+	   of CLOSED => ()
+	    | TOP => (TextIO.output(strm, "\n"); ctx := CLOSED)
+	    | _ => raise Fail "premature close"
+	  (* end case *))
 
     fun pr (P{strm, ...}, s) = TextIO.output(strm, s)
 
@@ -90,7 +94,8 @@ structure JSONStreamPrinter : sig
 	  (* end case *))
 
   (* print a value, which may be proceeded by a comma if it is in a sequence *)
-    fun prVal (p, v) = (optComma p; pr(p, v))
+    fun prVal (P{ctx = ref CLOSED, ...}, _) = raise Fail "closed printer"
+      | prVal (p, v) = (optComma p; pr(p, v))
 
     fun null p = prVal (p, "null")
     fun boolean (p, false) = prVal (p, "false")
@@ -122,16 +127,23 @@ structure JSONStreamPrinter : sig
 	    prVal (p, F.format "\"%s\"" [F.STR(tr (0, []))])
 	  end
 
-    fun beginObject (p as P{ctx, ...}) = (
-	  optComma p;
-	  pr (p, "{"); incIndent(p, 2); nl p;
-	  ctx := FIRST(OBJECT(!ctx)))
+    fun beginObject (p as P{ctx, ...}) = (case !ctx
+	   of CLOSED => raise Fail "closed printer"
+	    | _ => (
+		optComma p;
+		pr (p, "{"); incIndent(p, 2); nl p;
+		ctx := FIRST(OBJECT(!ctx)))
+	  (* end case *))
 
-    fun objectKey (p as P{ctx = ref(KEY _), ...}, field) =
-	  raise Fail(concat["objectKey \"", field, "\" where value was expected"])
-      | objectKey (p as P{ctx, ...}, field) = (
-	  string (p, field);
-	  ctx := KEY(!ctx))
+    fun objectKey (p as P{ctx, ...}, field) = (case !ctx
+	   of CLOSED => raise Fail "closed printer"
+	    | KEY _ => raise Fail(concat[
+		  "objectKey \"", field, "\" where value was expected"
+		])
+	    | _ => (
+		string (p, field);
+		ctx := KEY(!ctx))
+	  (* end case *))
 
     fun endObject (p as P{ctx, ...}) = let
 	  fun prEnd ctx' = (
@@ -139,16 +151,21 @@ structure JSONStreamPrinter : sig
 		indent(p, ~1); pr(p, "}"); decIndent (p, 2))
 	  in
 	    case !ctx
-	     of OBJECT ctx' => (nl p; prEnd ctx')
+	     of CLOSED => raise Fail "closed printer"
+	      | OBJECT ctx' => (nl p; prEnd ctx')
 	      | FIRST(OBJECT ctx') => prEnd ctx'
+	      | KEY _ => raise Fail "expecting value after key"
 	      | _ => raise Fail "endObject not in object context"
 	    (* end case *)
 	  end
 
-    fun beginArray (p as P{ctx, ...}) = (
-	  optComma p;
-	  pr (p, "["); incIndent(p, 2); nl p;
-	  ctx := FIRST(ARRAY(!ctx)))
+    fun beginArray (p as P{ctx, ...}) = (case !ctx
+	   of CLOSED => raise Fail "closed printer"
+	    | _ => (
+		optComma p;
+		pr (p, "["); incIndent(p, 2); nl p;
+		ctx := FIRST(ARRAY(!ctx)))
+	  (* end case *))
 
     fun endArray (p as P{ctx, ...}) = let
 	  fun prEnd ctx' = (
@@ -156,7 +173,8 @@ structure JSONStreamPrinter : sig
 		indent(p, ~1); pr(p, "]"); decIndent (p, 2))
 	  in
 	    case !ctx
-	     of ARRAY ctx' => (nl p; prEnd ctx')
+	     of CLOSED => raise Fail "closed printer"
+	      | ARRAY ctx' => (nl p; prEnd ctx')
 	      | FIRST(ARRAY ctx') => prEnd ctx'
 	      | _ => raise Fail "endArray not in array context"
 	    (* end case *)

src/JSON/patch/json-stream-printer.sml.patch

@@ -1,6 +1,6 @@
---- json-stream-printer.sml.orig	2017-07-14 22:32:40.000000000 +0200
-+++ json-stream-printer.sml	2017-10-25 20:33:53.541874000 +0200
-@@ -66,7 +66,7 @@
+--- json-stream-printer.sml.orig	2020-04-08 19:00:10.000000000 +0200
++++ json-stream-printer.sml	2020-07-03 15:23:14.218708000 +0200
+@@ -70,7 +70,7 @@
  		then TextIO.output(strm, String.extract(tenSpaces, 10-n, NONE))
  		else (TextIO.output(strm, tenSpaces); prIndent(n-10))
  	  in
@@ -9,7 +9,7 @@
  	  end
  
      fun incIndent (P{indent, ...}, n) = indent := !indent + n;
-@@ -103,14 +103,14 @@
+@@ -108,14 +108,14 @@
  	  fun tr (i, chrs) = (case getWChar i
  		 of SOME(wchr, i) => if (wchr <= 0w126)
  		      then (case UTF8.toAscii wchr
@@ -32,16 +32,16 @@
  			  | c => if (wchr < 0w32)
  			      then tr(i, F.format "\\u%04x" [F.WORD wchr] :: chrs)
  			      else tr(i, str c :: chrs)
-@@ -124,7 +124,7 @@
+@@ -131,7 +131,7 @@
+ 	   of CLOSED => raise Fail "closed printer"
+ 	    | _ => (
+ 		optComma p;
+-		pr (p, "{"); incIndent(p, 2); nl p;
++		pr (p, "{"); incIndent(p, 1); nl p;
+ 		ctx := FIRST(OBJECT(!ctx)))
+ 	  (* end case *))
  
-     fun beginObject (p as P{ctx, ...}) = (
- 	  optComma p;
--	  pr (p, "{"); incIndent(p, 2); nl p;
-+	  pr (p, "{"); incIndent(p, 1); nl p;
- 	  ctx := FIRST(OBJECT(!ctx)))
- 
-     fun objectKey (p as P{ctx = ref(KEY _), ...}, field) =
-@@ -136,7 +136,7 @@
+@@ -148,7 +148,7 @@
      fun endObject (p as P{ctx, ...}) = let
  	  fun prEnd ctx' = (
  		ctx := ctx';
@@ -49,14 +49,15 @@
 +		decIndent (p, 1); indent(p, 0); pr(p, "}"))
  	  in
  	    case !ctx
- 	     of OBJECT ctx' => (nl p; prEnd ctx')
-@@ -147,13 +147,13 @@
- 
-     fun beginArray (p as P{ctx, ...}) = (
- 	  optComma p;
--	  pr (p, "["); incIndent(p, 2); nl p;
-+	  pr (p, "["); incIndent(p, 1); nl p;
- 	  ctx := FIRST(ARRAY(!ctx)))
+ 	     of CLOSED => raise Fail "closed printer"
+@@ -163,14 +163,14 @@
+ 	   of CLOSED => raise Fail "closed printer"
+ 	    | _ => (
+ 		optComma p;
+-		pr (p, "["); incIndent(p, 2); nl p;
++		pr (p, "["); incIndent(p, 1); nl p;
+ 		ctx := FIRST(ARRAY(!ctx)))
+ 	  (* end case *))
  
      fun endArray (p as P{ctx, ...}) = let
  	  fun prEnd ctx' = (
@@ -65,4 +66,4 @@
 +		decIndent (p, 1); indent(p, 0); pr(p, "]"))
  	  in
  	    case !ctx
- 	     of ARRAY ctx' => (nl p; prEnd ctx')
+ 	     of CLOSED => raise Fail "closed printer"

src/JSON/patch/json-util.sml.orig

@@ -23,7 +23,7 @@ structure JSONUtil : sig
   (* exception that is raised when trying to process a non-array value as an array *)
     exception NotArray of JSON.value
 
-  (* exception that is raise when access to an array value is out of bounds *)
+  (* exception that is raised when access to an array value is out of bounds *)
     exception ArrayBounds of JSON.value * int
 
   (* map the above exceptions to a message string; we use General.exnMessage for other

src/JSON/patch/json-util.sml.patch

@@ -1,5 +1,5 @@
---- json-util.sml.orig	2017-04-29 17:39:27.000000000 +0200
-+++ json-util.sml	2017-10-04 00:40:39.574909000 +0200
+--- json-util.sml.orig	2020-04-09 14:52:10.000000000 +0200
++++ json-util.sml	2020-07-03 15:32:07.082015000 +0200
 @@ -133,7 +133,7 @@
  
      fun lookupField (v as J.OBJECT fields) = let