package ifneeded rl_json 0.11.0 \
    [list load librl_json[info sharedlibextension] rl_json]

LOCAL_C_INCLUDES := $(tcl_includes) $(tk_includes) $(LOCAL_PATH)/generic

LOCAL_EXPORT_C_INCLUDES := $(LOCAL_C_INCLUDES)

LOCAL_SRC_FILES := \
	generic/parser.c \
	generic/rl_json.c \
	generic/json_types.c \
	generic/dedup.c \
	generic/api.c \
	generic/rl_jsonStubInit.c

LOCAL_CFLAGS := $(tcl_cflags) $(tk_cflags) \
	-DPACKAGE_NAME="\"rl_json\"" \
	-DPACKAGE_VERSION="\"0.11.0\"" \
	-DTIP445_SHIM=1 -DDEDUP=1 \
	-O2

LOCAL_SHARED_LIBRARIES := libtcl

LOCAL_LDLIBS := -llog

include $(BUILD_SHARED_LIBRARY)

#========================================================================
# Your doc target should differentiate from doc builds (by the developer)
# and doc installs (see install-doc), which just install the docs on the
# end user machine when building from source.
#========================================================================

doc:

doc/json.html:

	cd doc && man2html -r json.n > json.html

install: all install-binaries install-libraries install-doc

install-binaries: binaries install-lib-binaries install-bin-binaries

#========================================================================
# This rule installs platform-independent files, such as header files.

dictionary which hold the values to interpolate.  When interpolating from
variables in the current scope, they name scalar or array variables which hold
the values to interpolate.  In either case if the named key or variable doesn't
exist, a JSON null is interpolated in its place.

Quick Reference
---------------
* [json get *json_val* ?*key* ...?]  - Extract the value of a portion of the *json_val*, returns the closest native Tcl type (other than JSON) for the extracted portion.


* [json extract *json_val* ?*key* ...?]  - Extract the value of a portion of the *json_val*, returns the JSON fragment.
* [json exists *json_val* ?*key* ...?]  - Tests whether the supplied key path resolve to something that exists in *json_val*
* [json set *json_variable_name* ?*key* ...? *value*]  - Updates the JSON value stored in the variable *json_variable_name*, replacing the value referenced by *key* ... with the JSON value *value*.
* [json unset *json_variable_name* ?*key* ...?]  - Updates the JSON value stored in the variable *json_variable_name*, removing the value referenced by *key* ...


* [json normalize *json_val*]  - Return a "normalized" version of the input *json_val* - all optional whitespace trimmed.
* [json template *json_val* ?*dictionary*?]  - Return a JSON value by interpolating the values from *dictionary* into the template, or from variables in the current scope if *dictionary* is not supplied, in the manner described above.
* [json string *value*]  - Return a JSON string with the value *value*.
* [json number *value*]  - Return a JSON number with the value *value*.
* [json boolean *value*]  - Return a JSON boolean with the value *value*.  Any of the forms accepted by Tcl_GetBooleanFromObj are accepted and normalized.
* [json object ?*key* *value* ?*key* *value* ...??]  - Return a JSON object with the keys and values specified.  *value* is a list of two elements, the first being the type {string, number, boolean, null, object, array, json}, and the second being the value.
* [json object *packed_value*]  - An alternate syntax that takes the list of keys and values as a single arg instead of a list of args, but is otherwise the same.
* [json array ?*elem* ...?]  - Return a JSON array containing each of the elements given.  *elem* is a list of two elements, the first being the type {string, number, boolean, null, object, array, json}, and the second being the value.
* [json foreach *varlist1* *json_val1* ?*varlist2* *json_val2* ...? *script*]  - Evaluate *script* in a loop in a similar way to the [foreach] command.  In each iteration, the values stored in the iterator variables in *varlist* are the JSON fragments from *json_val*.  Supports iterating over JSON arrays and JSON objects.  In the JSON object case, *varlist* must be a two element list, with the first specifiying the variable to hold the key and the second the value.  In the JSON array case, the rules are the same as the [foreach] command.
* [json lmap *varlist1* *json_val1* ?*varlist2* *json_val2* ...? *script*]  - As for [json foreach], except that it is collecting - the result from each evaluation of *script* is added to a list and returned as the result of the [json lmap] command.  If the *script* results in a TCL_CONTINUE code, that iteration is skipped and no element is added to the result list.  If it results in TCL_BREAK the iterations are stopped and the results accumulated so far are returned.
* [json amap *varlist1* *json_val1* ?*varlist2* *json_val2* ...? *script*]  - As for [json lmap], but the result is a JSON array rather than a list.  If the result of each iteration is a JSON value it is added to the array as-is, otherwise it is converted to a JSON string.
* [json omap *varlist1* *json_val1* ?*varlist2* *json_val2* ...? *script*]  - As for [json lmap], but the result is a JSON object rather than a list.  The result of each iteration must be a dictionary (or a list of 2n elements, including n = 0).  Tcl_ObjType snooping is done to ensure that the iteration over the result is efficient for both dict and list cases.  Each entry in the dictionary will be added to the result object.  If the value for each key in the iteration result is a JSON value it is  added to the array as-is, otherwise it is converted to a JSON string.
* [json isnull *json_val* ?*key* ...?]  - Return a boolean indicating whether the named JSON value is null.
* [json type *json_val* ?*key* ...?]  - Return the type of the named JSON value, one of "object", "array", "string", "number", "boolean" or "null".
* [json length *json_val* ?*key* ...?]  - Return the length of the of the named JSON array, number of entries in the named JSON object, or number of characters in the named JSON string.  Other JSON value types are not supported.
* [json keys *json_val* ?*key* ...?]  - Return the keys in the of the named JSON object, found by following the path of *key*s.
* [json pretty *json_val*]  - Returns a pretty-printed string representation of *json_val*.  Useful for debugging or inspecting the structure of JSON data.
* [json decode *bytes* ?*encoding*?]  - Decode the binary *bytes* into a character string according to the JSON standards.  The optional *encoding* arg can be one of *utf-8*, *utf-16le*, *utf-16be*, *utf-32le*, *utf-32be*.  The encoding is guessed from the BOM (byte order mark) if one is present and *encoding* isn't specified.
* [json valid ?*-extensions* *extensionlist*? ?*-details* *detailsvar*?  *json_val*]  - Return true if *json_val* conforms to the JSON grammar with the extensions in *extensionlist*.  Currently only one extension is supported: *comments*, and is the default.  To reject comments, use *-extensions {}*.  If *-details detailsvar* is supplied and the validation fails, the variable *detailsvar* is set to a dictionary with the keys *errmsg*, *doc* and *char_ofs*.  *errmsg* contains the reason for the failure, *doc* contains the failing json value, and *char_ofs* is the character index into *doc* of the first invalid character.

Paths
-----

The commands [json get], [json extract], [json set], [json unset] and [json exists]
accept a path specification that names some subset of the supplied *json_val*.
The rules are similar to the equivalent concept in the [dict] command, except
that the paths used by [json] allow indexing into JSON arrays by the integer
key (or a string matching the regex "^end(-[0-9]+)?$").  If a path to [json set]
includes a key within an object that doesn't exist, it and all later elements of
the path are created as nested keys into (new) objects.  If a path element into
an array is outside the current bounds of the array, it resolves to a JSON null
(for [json get], [json extract], [json exists]), or appends or prepends null

elements to resolve the path (for [json set], or does nothing ([json unset]).


~~~tcl
json get {
    {
        "foo": [
            { "name": "first" },
            { "name": "second" },
            { "name": "third" }
        }
    }
} foo end-1 name
~~~

Returns "second"

Properly Interpreting JSON from Other Systems
---------------------------------------------

Rl_json operates on characters, not bytes, and so considerations of encoding
are strictly out of scope.  However, interoperating with other systems
properly in a way that conforms to the standards is a bit tricky, and requires
support for encodings Tcl currently doesn't natively support, like utf-32be.
encodings Tcl currently doesn't natively support, like utf-32be.
To ease this burden and take care of things like replacing broken encoding
sequences, the [json decode] subcommand is provided.  Using it in an application
would look something like:

~~~tcl
proc readjson file {
    set h [open $file rb]    ;# Note that the file is opened in binary mode
    try {
        json decode [read $h]
    } finally {
        close $h
    }
}
~~~

If the encoding is known via some out-of-band channel (like headers in an
HTTP response), it can be supplied to override the BOM-based detection.
The supported encodings are those listed in the JSON standards: utf-8 (the
default), utf-16le, utf-16be, utf-32le and utf-32be.

Examples
--------

## Creating a document from a template

Produce a JSON value from a template:
~~~tcl
json template {
    {
        "thing1": "~S:val1",
        "thing2": ["a", "~N:val2", "~S:val2", "~B:val2", "~S:val3", "~L:~S:val1"],

    }
}
~~~
Result:
~~~json
{"thing1":"hello","thing2":["a",1000000.0,"1e6",true,null,"~S:val1"],"subdoc1":{"thing3":"~S:val1"},"subdoc2":{"thing3":"hello"}}
~~~

## Construct a JSON array from a SQL result set

~~~tcl
# Given:
# sqlite> select * from languages;
# 'Tcl',1,'http://core.tcl-lang.org/'
# 'Node.js',1,'https://nodejs.org/'
# 'Python',1,'https://www.python.org/'
# 'INTERCAL',0,'http://www.catb.org/~esr/intercal/'
# 'Unlambda',0,NULL

set langs {[]}
sqlite3 db languages.sqlite3
db eval {
    select
        rowid,
        name,
        active,
        url
    from
        languages
} {
    if {$url eq ""} {unset url}

    json set langs end+1 [json template {
        {
            "id":       "~N:rowid",
            "name":     "~S:name",
            "details": {
                "active":   "~B:active",  // Template values can be nested anywhere
                "url":      "~S:url"      /* Both types of comments are
                                             allowed but stripped at parse-time */
            }
        }
    }]
}

puts [json pretty $langs]
~~~
Result:
~~~json
[
    {
        "id":      1,
        "name":    "Tcl",
        "details": {
            "active": true,
            "url":    "http://core.tcl-lang.org/"
        }
    },
    {
        "id":      2,
        "name":    "Node.js",
        "details": {
            "active": true,
            "url":    "https://nodejs.org/"
        }
    },
    {
        "id":      3,
        "name":    "Python",
        "details": {
            "active": true,
            "url":    "https://www.python.org/"
        }
    },
    {
        "id":      4,
        "name":    "INTERCAL",
        "details": {
            "active": false,
            "url":    "http://www.catb.org/~esr/intercal/"
        }
    },
    {
        "id":      5,
        "name":    "Unlambda",
        "details": {
            "active": false,
            "url":    null
        }
    }
]
~~~

## Performance

Good performance was a requirement for rl_json, because it is used to handle
large volumes of data flowing to and from various JSON based REST apis.  It's
generally the fastest option for working with JSON values in Tcl from the
options I've tried, with the next closest being yajltcl.  These benchmarks

    old_json_parse |  241.595
     rl_json_parse |    5.540
       rl_json_get |    4.950
           yajltcl |    8.800
rl_json_get_native |    0.800
```

### Validating

If the requirement is to validate a JSON value, the [json valid] command is a
light-weight version of the parsing engine that skips allocating values from
the document and only returns whether the parsing succeeded or failed, and
optionally a description of the failure.  It takes about a third of the time
to validate a document as parsing it, so the performance win is substantial.
On a relatively modern CPU validation takes about 11 cycles per byte, or around
200MB of JSON per second on a 2.3 GHz Intel i7.

### Generating

This benchmark compares the relative performance of various ways of
dynamically generating a JSON document.  Although all the methods produce the
same string, only the "template" and "template_dict" variants handle nulls in
the general case - the others manually test for null only for the one field
that is known to be null, so the performance of these variants would be worse

     rl_json_new |   10.240
        template |    4.520
         yajltcl |    7.700
   template_dict |    2.500
    yajltcl_dict |    7.530
```

Deprecations
------------

Version 0.10.0 deprecates various subcommands and features, which will be removed in a near future version:

* [json get_type *json_val* ?*key* ...?]  - Removed
    * lassign [json get_type *json_val* ?*key* ...?] val type  ->  set val [json get *json_val* ?*key* ...?]; set type [json type *json_val* ?*key* ...?]
* [json parse *json_val*]  - A deprecated synonym for [json get *json_val*].
* [json fmt *type* *value*]  - A deprecated synonym for [json new *type* *value*], which is itself deprecated, see below.
* [json new *type* *value*]  - Use direct subcommands of [json]:
    * [json new string *value*] -> [json string *value*]
    * [json new number *value*] -> [json number *value*]
    * [json new boolean *value*] -> [json boolean *value*]
    * [json new true] -> true
    * [json new false] -> false
    * [json new null] -> null
    * [json new json *value*] -> *value*
    * [json new object ...] -> [json object ...]   (but consider [json template])
    * [json new array ...] -> [json array ...]   (but consider [json template])
* modifiers at the end of a path  - Modifiers like [json get *json_val* foo ?type] are deprecated.  Replacements are:
    * ?type  - use [json type *json_val* ?*key* ...?]
    * ?length - use [json length *json_val* ?*key* ...?]
    * ?size - use [json length *json_val* ?*key* ...?]
    * ?keys - use [json keys *json_val* ?*key* ...?]

Under the Hood
--------------

Older versions used the yajl c library to parse the JSON string and properly
quote generated strings when serializing JSON values, but currently a custom
built parser and string quoter is used, removing the libyajl dependency.  JSON
values are parsed to an internal format using Tcl_Objs and stored as the

AC_DEFUN([TEAX_CONFIG_LINK_LINE], [
    AS_IF([test ${TCL_LIB_VERSIONS_OK} = nodots], [
	eval "$1=\"-L[]CygPath($2) -l$3${TCL_TRIM_DOTS}\""
    ], [
	eval "$1=\"-L[]CygPath($2) -l$3${PACKAGE_VERSION}\""
    ])
    AC_SUBST($1)])

#
# Add here whatever m4 macros you want to define for your package
#

AC_DEFUN([ENABLE_ENSEMBLE], [
	#trap 'echo "val: (${enable_ensemble+set}), ensemble_ok: ($ensemble_ok), ensemble: ($ENSEMBLE)"' DEBUG
	AC_MSG_CHECKING([whether to provide the json command as an ensemble])
	AC_ARG_ENABLE(ensemble,
		AC_HELP_STRING([--enable-ensemble], [Provide the json command using a proper ensemble, otherwise handle the subcommand dispatch internally (default: no)]),
		[ensemble_ok=$enableval], [ensemble_ok=no])

	if test "$ensemble_ok" = "yes" -o "${ENSEMBLE}" = 1; then
		ENSEMBLE=1
		AC_MSG_RESULT([yes])
	else
		ENSEMBLE=0
		AC_MSG_RESULT([no])
	fi

	AC_DEFINE_UNQUOTED([ENSEMBLE], [$ENSEMBLE], [Ensemble enabled?])
	#trap '' DEBUG
])


AC_DEFUN([ENABLE_DEDUP], [
	#trap 'echo "val: (${enable_dedup+set}), dedup_ok: ($dedup_ok), DEDUP: ($DEDUP)"' DEBUG
	AC_MSG_CHECKING([whether to use a string deduplication mechanism for short strings])
	AC_ARG_ENABLE(dedup,
		AC_HELP_STRING([--enable-dedup], [Parsing JSON involves allocating a lot of small string Tcl_Objs, many of which are duplicates.  This mechanism helps reduce that duplication (default: yes)]),
		[dedup_ok=$enableval], [dedup_ok=yes])

	if test "$dedup_ok" = "yes" -o "${DEDUP}" = 1; then
		DEDUP=1
		AC_MSG_RESULT([yes])
	else
		DEDUP=0
		AC_MSG_RESULT([no])
	fi

	AC_DEFINE_UNQUOTED([DEDUP], [$DEDUP], [Dedup enabled?])
	#trap '' DEBUG
])


AC_DEFUN([TIP445], [
	AC_MSG_CHECKING([whether we need to polyfill TIP 445])
	saved_CFLAGS="$CFLAGS"
	CFLAGS="$CFLAGS $TCL_INCLUDE_SPEC"
	AC_TRY_COMPILE([#include <tcl.h>], [Tcl_ObjIntRep ir;],
	    have_tcl_objintrep=yes, have_tcl_objintrep=no)
	CFLAGS="$saved_CFLAGS"

	if test "$have_tcl_objintrep" = yes; then
		AC_DEFINE(TIP445_SHIM, 0, [Do we need to polyfill TIP 445?])
		AC_MSG_RESULT([no])
	else
		AC_DEFINE(TIP445_SHIM, 1, [Do we need to polyfill TIP 445?])
		AC_MSG_RESULT([yes])
	fi
])


dnl Local Variables:
dnl mode: autoconf
dnl End:

if {"bench" ni [info commands bench]} {
	package require bench
	namespace import bench::*
}

package require rl_json

namespace import rl_json::json

proc main {} {
bench as_json-1.1 {[json boolean] vs implicit} -setup { #<<<
} -compare {
	explicit {
		set doc {[]}
		for {set i 0} {$i < 10} {incr i} {
			json set doc end+1 [json boolean true]
		}
		set doc
	}

	implicit_literal {
		set doc {[]}
		for {set i 0} {$i < 10} {incr i} {
			json set doc end+1 true
		}
		set doc
	}

	implicit_var {
		set doc {[]}
		set v	true
		for {set i 0} {$i < 10} {incr i} {
			json set doc end+1 $v
		}
		set doc
	}

	implicit_parsed {
		set doc {[]}
		for {set i 0} {$i < 10} {incr i} {
			json set doc end+1 [string trim " true"]
		}
		set doc
	}
} -cleanup {
	unset -nocomplain doc i v
} -result {[true,true,true,true,true,true,true,true,true,true]}
#>>>
bench as_json-2.1 {[json number] vs implicit} -setup { #<<<
} -compare {
	explicit {
		set doc {[]}
		for {set i 0} {$i < 10} {incr i} {
			json set doc end+1 [json number $i]
		}
		set doc
	}

	implicit_var {
		set doc {[]}
		for {set i 0} {$i < 10} {incr i} {
			json set doc end+1 $i
		}
		set doc
	}

	implicit_parsed {
		set doc {[]}
		for {set i 0} {$i < 10} {incr i} {
			json set doc end+1 " $i"
		}
		set doc
	}
} -cleanup {
	unset -nocomplain doc i
} -result {[0,1,2,3,4,5,6,7,8,9]}
#>>>
bench as_json-2.2 {[json number] vs implicit} -setup { #<<<
} -compare {
	explicit {
		set doc {[]}
		for {set i 0} {$i < 10} {incr i} {
			json set doc end+1 [json number 1e$i]
		}
		set doc
	}

	implicit_var {
		set doc {[]}
		for {set i 0} {$i < 10} {incr i} {
			json set doc end+1 1e$i
		}
		set doc
	}
} -cleanup {
	unset -nocomplain doc i
} -match glob -result *
# -result {[1e0,1e1,1e2,1e3,1e4,1e5,1e6,1e7,1e8,1e9]}
# -result {[1.0,10.0,100.0,1000.0,10000.0,100000.0,1000000.0,10000000.0,100000000.0,1000000000.0]}
#>>>
bench as_json-3.2 {[json string] vs implicit} -setup { #<<<
} -compare {
	explicit {
		set doc {[]}
		for {set i 0} {$i < 10} {incr i} {
			json set doc end+1 [json string false$i]
		}
		set doc
	}

	implicit_var {
		set doc {[]}
		for {set i 0} {$i < 10} {incr i} {
			json set doc end+1 false$i
		}
		set doc
	}
} -cleanup {
	unset -nocomplain doc i
} -result {["false0","false1","false2","false3","false4","false5","false6","false7","false8","false9"]}

}

main
# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4

		close $h
	}
}

#>>>
proc _run_if_set script { #<<<
	if {$script eq ""} return
	uplevel 2 [list if 1 $script]
}

#>>>
proc _verify_res {variant retcodes expected match_mode got options} { #<<<
	if {[dict get $options -code] ni $retcodes} {
		bench::output error "Error: $got"
		throw [list BENCH BAD_CODE $variant $retcodes [dict get $options -code]] \

	} val [math::statistics::basic-stats $times] {
		dict set res $stat $val
	}
	dict set res median [math::statistics::median $times]
	dict set res harmonic_mean [/ [llength $times] [+ {*}[lmap time $times {
		/ 1.0 $time
	}]]]
	dict set res cv [expr {[dict get $res population_stddev] / [dict get $res arithmetic_mean]}]
}

#>>>
proc bench {name desc args} { #<<<
	variable match
	variable run
	variable skipped
	variable output

	# -target_cv		- Run until the coefficient of variation is below this, up to -max_time
	# -max_time 		- Maximum number of seconds to keep running while the cv is converging
	# -min_time			- Keep accumulating samples for at least this many seconds
	# -batch			- The number of samples to take in a tight loop and average to count as a single sample.  "auto" guesses a reasonable value to make a batch take at least 1000 usec.
	# -window			- Consider at most the previous -window measurements for target_cv and the results
	array set opts {
		-setup			{}
		-compare		{}
		-cleanup		{}
		-batch			auto
		-match			exact
		-returnCodes	{ok return}
		-target_cv		{0.0015}
		-min_time		0.0
		-max_time		4.0
		-min_it			30
		-window			30
	}
	array set opts $args
	set badargs [lindex [_intersect3 [array names opts] {
		-setup -compare -cleanup -batch -match -result -returnCodes -target_cv -min_time -max_time -min_it -window
	}] 0]

	if {[llength $badargs] > 0} {
		error "Unrecognised arguments: [join $badargs {, }]"
	}

	if {![string match $match $name]} {

			continue	{list 4}
			default		{set e}
		}
	}]

	set make_script {
		{batch script} {
			format {set __bench_i %d; while {[incr __bench_i -1] >= 0} %s} \
				[list $batch] [list $script]
		}
	}














	set variant_stats {}

	_run_if_set $opts(-setup)
	try {
		dict for {variant script} $opts(-compare) {
			set hint	[lindex [time {
				catch {uplevel 1 $script} r o
			}] 0]
			if {[info exists opts(-result)]} {
				_verify_res $variant $normalized_codes $opts(-result) $opts(-match) $r $o
			}

			set single_empty {
				uplevel 1 [list if 1 {}]
			}
			set single_ex_s	{
				uplevel 1 [list if 1 $script]
			}
			if 1 $single_empty	;# throw the first away
			if 1 $single_ex_s	;# throw the first away

			set single_overhead	[lindex [time $single_empty 1000] 0]
			#puts stderr "single overhead: $single_overhead"

			# Verify the first result against -result (if given), and estimate an appropriate batchsize to target a batch time of 1 ms to reduce quantization noise <<<
			set est_it	[expr {
				max(1, int(round(
					100.0/$hint
				)))
			}]
			#puts stderr "hint: $hint, est_it: $est_it"
			set extime	[lindex [time $single_ex_s $est_it] 0]
			set extime_comp	[expr {$extime - $single_overhead}]
			#puts stderr "extime: $extime, extime comp: $extime_comp"
			if {$opts(-batch) eq "auto"} {
				set batch	[expr {int(round(max(1, 1000.0/$extime_comp)))}]
				#puts stderr "Guessed batch size of $batch based on sample execution time $extime_comp usec"
			} else {
				set batch	$opts(-batch)
			}
			#>>>

			# Measure the instrumentation overhead to compensate for it <<<
			set times	{}
			set start	[clock microseconds]	;# Prime [clock microseconds], start var
			set bscript	[apply $make_script $batch {}]
			uplevel 1 [list if 1 $script]
			for {set i 0} {$i < int(100000 / ($batch*0.15))} {incr i} {
				set start [clock microseconds]
				uplevel 1 [list if 1 $bscript]
				lappend times [- [clock microseconds] $start]
			}
			set overhead	[::tcl::mathfunc::min {*}[lmap e $times {expr {$e / double($batch)}}]]
			#apply $output debug [format {Overhead: %.3f usec, mean: %.3f for batch %d} $overhead [expr {double([+ {*}$times]) / ([llength $times]*$batch)}] $batch]
			# Measure the instrumentation overhead to compensate for it >>>

			set cv {data { # Calculate the coefficient of variation of $data <<<
				lassign [::math::statistics::basic-stats $data] \
					arithmetic_mean min max number_of_data sample_stddev sample_var population_stddev population_var

				expr {
					$population_stddev / double($arithmetic_mean)
				}
			}}
			#>>>

			set begin	[clock microseconds]	;# Don't count the first run time or the overhead measurement into the total elapsed time
			set it		0
			set times	{}
			set means	{}
			set cvmeans	{}
			set cvtimes	{}
			set elapsed	0
			set bscript	[apply $make_script $batch $script]
			#puts stderr "bscript $variant: $bscript"
			# Run at least:
			# - -min_it times
			# - for half a second
			# - until the coefficient of variability of the means has fallen below -target_cv, or a max of -max_time seconds
			while {
				[llength $times] < $opts(-min_it) ||
				$elapsed < $opts(-min_time) ||
				($elapsed < $opts(-max_time) && $cvmeans > $opts(-target_cv))
			} {
				set start [clock microseconds]
				uplevel 1 [list if 1 $bscript]
				set batchtime	[- [clock microseconds] $start]
				lappend times [expr {
					$batchtime / double($batch) - $overhead
				}]
				set elapsed		[expr {([clock microseconds] - $begin)/1e6}]
				set cvtimes		[lrange $times end-[+ 1 $opts(-window)] end]	;# Consider the last $opts(-window) data in estimating the variation
				lappend means	[expr {[+ {*}$cvtimes]/[llength $cvtimes]}]
				set _cv			[apply $cv $cvtimes]
				set cvmeans		[apply $cv [lrange $means end-[+ 1 $opts(-window)] end]]
				#puts stderr "Got time for $variant batch($batch), batchtime $batchtime usec: [format %.4f [lindex $times end]], elapsed: [format %.3f $elapsed] sec[if {[info exists cvmeans]} {format {, cvmeans: %.3f} $cvmeans}][if {[info exists _cv]} {format {, cv: %.3f} $_cv}], mean: [format %.5f [lindex $means end]]"
			}

			dict set variant_stats $variant [_make_stats $cvtimes]
			dict set variant_stats $variant cvmeans		$cvmeans
			dict set variant_stats $variant cv			[apply $cv $cvtimes]
			dict set variant_stats $variant runtime		$elapsed
			dict set variant_stats $variant it			[llength $cvtimes]
		}

		lappend run $name $desc $variant_stats
	} finally {
		_run_if_set $opts(-cleanup)
	}
}; namespace export bench

				if {![dict exists $stats $variant]} {
					#string cat --
					set _ --
				} else {
					set val		[dict get $stats $variant $pick]
					if {![info exists baseline]} {
						set baseline	$val
						format {%.3f%s} $val [expr {
							[dict exists $stats $variant cv] ? [format { cv:%.1f%%} [expr {100*[dict get $stats $variant cv]}]] : ""
						}]
					} elseif {$baseline == 0} {
						format x%s inf
					} else {
						format {x%.3f%s} [/ $val $baseline] [expr {
							[dict exists $stats $variant cv] ? [format { cv:%.1f%%} [expr {100*[dict get $stats $variant cv]}]] : ""
						}]
					}
				}
			}]
		}]

		# Determine the column widths
		set colsize	{}

			upvar 1 i i args args
			set from	$i
			incr i $count
			lrange $args $from [+ $from $count -1]
		} [namespace current] \
	]

	# Automatically save and compare with the previous run
	set args [list {*}{
		-relative last last
	} {*}$args]

	set i	0
	while {$i < [llength $args]} {
		lassign [apply $consume_args 1] next

		switch -- $next {
			-match {
				lassign [apply $consume_args 1] match
			}

			-relative {
				lassign [apply $consume_args 2] label rel_fn
				if {[file readable $rel_fn]} {
					dict set relative $label [_readfile $rel_fn]
				}
			}

			-save {
				lassign [apply $consume_args 1] save_fn
			}

			-display {

					"Invalid argument: \"$next\""
			}
		}
	}

	set stats	{}
	foreach f [glob -nocomplain -type f -dir $dir -tails *.bench] {
		uplevel 1 [list if 1 [list source [file join $dir $f]]]
	}

	set save {{save_fn run} {
		set save_data	$run
		if {[file readable $save_fn]} {
			# If the save file already exists, merge this run's data with it
			# rather than replacing it (keeps old tests that weren't executed
			# in this run)
			set newkeys	[lmap {relname - -} $save_data {set relname}]
			set old		[_readfile $save_fn]
			foreach {relname reldesc relstats} $old {
				if {$relname in $newkeys} continue
				lappend save_data $relname $reldesc $relstats
			}
		}
		_writefile $save_fn $save_data
	}}

	apply $save last $run	;# Always save as "last", even if explicitly saving as something else too
	if {[info exists save_fn]} {
		apply $save $save_fn $run
	}

	foreach {name desc variant_stats} $run {
		set relative_stats	{}
		foreach {label relinfo} $relative {
			foreach {relname reldesc relstats} $relinfo {
				if {$relname eq $name} {

if {"bench" ni [info commands bench]} {
	package require bench
	namespace import bench::*
}

package require rl_json
package require yajltcl
package require json_old

namespace import rl_json::json

proc main {} {
bench new-1.1 {Various ways of dynamically assembling a JSON doc} -setup { #<<<
	array set a {
		x		"str\"foo\nbar"
		y		123
		on		yes
		off		0
		subdoc	{{"inner": "~S:bar"}}

				[expr {[info exists a(not_defined)] ? [list s $a(not_defined)] : [list null]}] \
				[list s "~S:not a subst"] \
				[list o inner [list s $bar]] \
				[list o inner2 [list s $bar]] \
			] \
		]
	}

	template_string {
		json template_string {
			{
				"foo": "~S:bar",
				"baz": [
					"~S:a(x)",
					"~N:a(y)",
					123.4,
					"~B:a(on)",
					"~B:a(off)",
					"~S:a(not_defined)",
					"~L:~S:not a subst",
					"~T:a(subdoc)",
					"~T:a(subdoc2)"
				]
			}
		}
	}

	template {
		json template {
			{
				"foo": "~S:bar",
				"baz": [
					"~S:a(x)",

			y get
		} finally {
			y delete
		}
	}

	template_string_dict {
		json template_string {
			{
				"foo": "~S:bar",
				"baz": [
					"~S:a(x)",
					"~N:a(y)",
					123.4,
					"~B:a(on)",

			y delete
		}
	}
} -cleanup {
	unset -nocomplain a d
} -result {{"foo":"Bar","baz":["str\"foo\nbar",123,123.4,true,false,null,"~S:not a subst",{"inner":"Bar"},{"inner2":"Bar"}]}}
#>>>
}
main

# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4

if {"bench" ni [info commands bench]} {
	package require bench
	namespace import bench::*
}

package require rl_json
#package require yajltcl

namespace import rl_json::json

proc main {} {
bench normalize-1.1 {Normalize a JSON doc} -setup { #<<<
	set json {
		{
			"foo": "bar",
			"baz": ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	}
} -compare {
	ours {
		json normalize [string trim $json]
	}
} -cleanup {
	unset -nocomplain json
} -result {{"foo":"bar","baz":["str",123,123.4,true,false,null,{"inner":"obj"}]}}
#>>>
}
main

# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4

		read $h
	} finally {
		close $h
	}
}
#>>>

proc main {} {
bench parse-1.1 {Parse a small JSON doc and extract a field} -setup { #<<<
	set json {
		{
			"foo": "bar",
			"baz": ["str", 123, 123.4, true, false, null, {"inner": "obj"}]
		}
	}

bench parse-2.1 {Parse a few MB of json} -batch 3 -setup { #<<<
	set json [readfile [file join [file dirname [file normalize [info script]]] items1.json]]
} -compare {
	just_parse {
		json normalize $json
		list 83000 5434
	}
	valid {
		json valid $json
		list 83000 5434
	}
	valid_no_comments {
		json valid -extensions {} $json
		list 83000 5434
	}
	ours {
		set c	0
		set nrpics	0
		set p	[string trim $json]
		json foreach hit [json extract $p hits hits] {
			if {[json exists $hit _source shopstatus]} {
				json get $hit _source shopstatus

}
if {[file readable [file join [file dirname [file normalize [info script]]] sample.json]]} {
bench parse-3.1 {Parse a large json doc with deep nesting and many UTF-8 chars} -batch 3 -setup { #<<<
	# Sample from the json-test-suite project: https://code.google.com/p/json-test-suite/downloads/detail?name=sample.zip
	set json [readfile [file join [file dirname [file normalize [info script]]] sample.json]]
} -compare {
	ours {
		json length [string trim $json]
	}
	yajltcl {
		dict size [yajl::json2dict [string trim $json]]
	}
	valid {
		json valid $json
		return -level 0 3
	}
} -cleanup {
	unset -nocomplain json
} -result 3
#>>>
}
}
main

# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4

if {"bench" ni [info commands bench]} {
	package require bench
	namespace import bench::*
}

package require rl_json

namespace import rl_json::json

proc main {} {
bench piecewise_template-1.1 {Templated document creation in multiple steps} -setup { #<<<
	set tmpl {
		{
			"foo": "~S:foo",
			"bar": "~S:a(bar)",
			"baz": "~N:baz",
			"recurse": "~J:last"
		}
	}
	set foo	Foo
	array set a {
		foo		X
		bar		Bar
	}
} -compare {
	serialize {
		unset -nocomplain last
		for {set i 0} {$i < 6} {incr i} {
			set last	[json template_string $tmpl]
		}
		set last
	}
	direct {
		unset -nocomplain last
		for {set i 0} {$i < 6} {incr i} {
			set last	[json template $tmpl]
		}
		set last
	}
} -cleanup {
	unset -nocomplain tmpl a foo i last
} -result [json normalize {
	{
		"foo": "Foo",
		"bar": "Bar",
		"baz": null,
		"recurse": {
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": {
				"foo": "Foo",
				"bar": "Bar",
				"baz": null,
				"recurse": {
					"foo": "Foo",
					"bar": "Bar",
					"baz": null,
					"recurse": {
						"foo": "Foo",
						"bar": "Bar",
						"baz": null,
						"recurse": {
							"foo": "Foo",
							"bar": "Bar",
							"baz": null,
							"recurse": null
						}
					}
				}
			}
		}
	}
}]
#>>>
bench piecewise_template-1.2 {Templated document creation in a loop} -setup { #<<<
	set tmpl {
		{
			"foo": "~S:foo",
			"bar": "~S:a(bar)",
			"baz": "~N:baz",
			"recurse": "~J:last"
		}
	}
	set foo	Foo
	array set a {
		foo		X
		bar		Bar
	}
} -compare {
	serialize {
		set res {[]}
		for {set i 0} {$i < 20} {incr i} {
			json set res end+1 [json template_string $tmpl]
		}
		set res
	}
	direct {
		set res {[]}
		for {set i 0} {$i < 20} {incr i} {
			json set res end+1 [json template $tmpl]
		}
		set res
	}
} -cleanup {
	unset -nocomplain tmpl a foo i last res
} -result [json normalize {
	[
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		},
		{
			"foo": "Foo",
			"bar": "Bar",
			"baz": null,
			"recurse": null
		}
	]
}]
#>>>
}
main

# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4

#!/usr/bin/env cfkit8.6
# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4

set big	[string repeat a [expr {int(1e8)}]]	;# Allocate 100MB to pre-expand the zippy pool
unset big

if {[file system [info script]] eq "native"} {
	package require platform

	foreach platform [platform::patterns [platform::identify]] {
		set tm_path		[file join $env(HOME) .tbuild repo tm $platform]
		set pkg_path	[file join $env(HOME) .tbuild repo pkg $platform]

}

set here	[file dirname [file normalize [info script]]]
set parent	[file dirname $here]
tcl::tm::path add $here
lappend auto_path $parent

package require platform
package require bench

proc with_chan {var create use} {
	upvar 1 $var h
	set h	[uplevel 1 [list if 1 $create]]
	try {
		uplevel 1 [list if 1 $use]
	} on return {r o} - on break {r o} - on continue {r o} {
		dict incr o -level 1
		return -options $o $r
	} finally {
		if {[info exists h] && $h in [chan names]} {
			catch {close $h}
		}
	}
}

proc readtext fn { with_chan h {open $fn r} {read $h} }


proc benchmark_mode script {
	set restore_state_actions	{}

	with_chan root {open |[list sudo [info nameofexecutable]] rb+} {
		chan configure $root -encoding binary -translation binary
		proc sudo args {
			upvar 1 root root
			puts $root [encoding convertto utf-8 [string map [list %script% [list $args]] {
				catch %script% r o
				set resp [encoding convertto utf-8 [list $r $o]]
				puts -nonewline [string length $resp]\n$resp
				flush stdout
			}]]
			flush $root
			set bytes	[gets $root]
			if {$bytes eq ""} {
				if {[eof $root]} {
					puts stderr "Root child died"
					close $root
					unset root
					return
				}
			}
			if {![string is integer -strict $bytes]} {
				error "Root child sync error"
			}
			lassign [encoding convertfrom utf-8 [read $root $bytes]] r o
			return -options $o $r
		}
		sudo eval {
			#chan configure stdin -buffering none -encoding utf-8
			chan configure stdout -buffering none -encoding binary -translation binary

			proc with_chan {var create use} {
				upvar 1 $var h
				set h	[uplevel 1 [list if 1 $create]]
				try {
					uplevel 1 [list if 1 $use]
				} on return {r o} - on break {r o} - on continue {r o} {
					dict incr o -level 1
					return -options $o $r
				} finally {
					if {[info exists h] && $h in [chan names]} {
						close $h
					}
				}
			}

			proc readtext fn          { with_chan h {open $fn r} {read $h} }
			proc writetext {fn value} { with_chan h {open $fn w} {puts -nonewline $h $value} }

			proc set_turbo state {
				if {$state} {
					set mode "turbo enable\nquit"
				} else {
					set mode "turbo disable\nquit"
				}
				#with_chan h {open |[list i7z_rw_registers 2>@ stderr] w} {
				#	chan configure $h -buffering none -encoding binary -translation binary -blocking 1
				#	puts $h $mode
				#}
				set res	[exec echo $mode | i7z_rw_registers]
				if {[regexp {Turbo is now (Enabled|Disabled)} $res - newstate]} {
					set newstate
				} else {
					set res
				}
			}

			proc get_turbo {} {
				expr {
					![exec rdmsr 0x1a0 --bitfield 38:38]
				}
			}
		}

		try {
			switch -glob -- [platform::generic] {
				linux-* {
					# Disable turbo boost <<<
					#lappend restore_state_actions	[list sudo set_turbo 1]
					lappend restore_state_actions	[list sudo set_turbo [sudo get_turbo]]
					sudo set_turbo off
					# Disable turbo boost >>>

					# Disable frequency scaling <<<
					foreach governor [glob -nocomplain -type f /sys/devices/system/cpu/cpu*/cpufreq/scaling_governor] {
						lappend restore_state_actions [list sudo writetext $governor [string trim [readtext $governor]]]
						#lappend restore_state_actions [list sudo writetext $governor powersave]
						sudo writetext $governor performance
					}
					# Disable frequency scaling >>>

					# Set highest scheduling priority
					lappend restore_state_actions	[list sudo exec renice --priority [exec nice] [pid]]
					sudo exec renice --priority -20 [pid]


					# Disable hyperthreading (effectively by disabling sibling cores, preventing the kernel from scheduling tasks for them)
					set siblings	{}
					foreach core [glob -nocomplain -type d -directory /sys/devices/system/cpu -tails cpu*] {
						if {![regexp {^cpu[0-9]+$} $core]} continue
						if {[file readable /sys/devices/system/cpu/$core/online]} {
							lappend restore_state_actions [list sudo writetext /sys/devices/system/cpu/$core/online [string trim [readtext /sys/devices/system/cpu/$core/online]]]
							#lappend restore_state_actions [list sudo writetext /sys/devices/system/cpu/$core/online 1]
						}
						set sibs	[readtext /sys/devices/system/cpu/$core/topology/thread_siblings_list]
						dict lappend siblings $sibs $core
					}
					dict for {group cores} $siblings {
						set keep	[lmap core $cores {
							if {[file readable /sys/devices/system/cpu/$core/online]} continue
							set core
						}]
						if {$keep eq {}} {
							set keep	[list [lindex $cores 0]]
						}
						foreach core $cores {
							if {$core in $keep} continue
							sudo writetext /sys/devices/system/cpu/$core/online 0
						}
					}
				}

				default {
					puts stderr "Don't know the magic to set [platform::generic] up for repeatable benchmarking"
				}
			}

			uplevel 1 [list if 1 $script]
		} finally {
			foreach action [lreverse $restore_state_actions] {
				#puts stderr "Running restore action:\t$action"
				set errors 0
				try $action on error {errmsg options} {
					puts stderr "Error processing restore action \"$action\": [dict get $options -errorinfo]"
					set errors	1
				}
				if {$errors} {
					throw exit 2
				}
			}
		}
		close $root write
		read $root
	}
}

proc main {} {
	try {
		set here	[file dirname [file normalize [info script]]]
		benchmark_mode {
			puts "[string repeat - 80]\nStarting benchmarks\n"
			bench::run_benchmarks $here {*}$::argv
		}
	} on ok {} {
		exit 0
	} trap {BENCH INVALID_ARG} {errmsg options} {
		puts stderr $errmsg
		exit 1
	} trap exit code {
		exit $code
	} on error {errmsg options} {
		puts stderr "Unhandled error from benchmark_mode: [dict get $options -errorinfo]"
		exit 2
	}
}

main

# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4

if {"bench" ni [info commands bench]} {
	package require bench
	namespace import bench::*
}

package require rl_json

namespace import rl_json::json

proc main {} {
bench template-1.1 {Basic templated document creation} -setup { #<<<
	set tmpl {
		{
			"foo": "~S:foo",
			"bar": "~S:a(bar)",
			"baz": "~N:baz"
		}
	}
	set foo	Foo
	array set a {
		foo		X
		bar		Bar
	}
} -compare {
	dict {
		json template_string $tmpl {
			foo		Foo
			a(bar)	Bar
		}
	}

	dict_lit {
		json template_string {
			{
				"foo": "~S:foo",
				"bar": "~S:a(bar)",
				"baz": "~N:baz"
			}
		} {
			foo		Foo
			a(bar)	Bar
		}
	}

	variables {
		json template_string $tmpl
	}

	dict_direct {
		json template $tmpl {
			foo		Foo
			a(bar)	Bar
		}
	}

	dict_lit_direct {
		json template {
			{
				"foo": "~S:foo",
				"bar": "~S:a(bar)",
				"baz": "~N:baz"
			}
		} {
			foo		Foo
			a(bar)	Bar
		}
	}

	variables_direct {
		json template $tmpl
	}
} -cleanup {
	unset -nocomplain tmpl a foo
} -result [json normalize {
	{
		"foo": "Foo",
		"bar": "Bar",
		"baz": null
	}
}]
#>>>
bench template-2.1 {Test templated doc creation, including numbers} -setup { #<<<
	set foo		1
	set bar		42.5
	set baz		1e6
	set quux	0x42
	set octal	077
	set space	" 42"

	set d {
		foo		1
		bar		42.5
		baz		1e6
		quux	0x42
		octal	077
		space	" 42"
	}
} -compare {
	template_string {
		json template_string {
			{
				"foo":		"~N:foo",
				"bar":		"~N:bar",
				//"baz":		"~N:baz",
				"quux":		"~N:quux",
				"octal":	"~N:octal",
				"space":	"~N:space"
			}
		}
	}

	template_string_dict {
		json template_string {
			{
				"foo":		"~N:foo",
				"bar":		"~N:bar",
				//"baz":		"~N:baz",
				"quux":		"~N:quux",
				"octal":	"~N:octal",
				"space":	"~N:space"
			}
		} $d
	}

	template {
		json template {
			{
				"foo":		"~N:foo",
				"bar":		"~N:bar",
				//"baz":		"~N:baz",
				"quux":		"~N:quux",
				"octal":	"~N:octal",
				"space":	"~N:space"
			}
		}
	}

	template_dict {
		json template_string {
			{
				"foo":		"~N:foo",
				"bar":		"~N:bar",
				//"baz":		"~N:baz",
				"quux":		"~N:quux",
				"octal":	"~N:octal",
				"space":	"~N:space"
			}
		} $d
	}
} -cleanup {
	unset -nocomplain foo bar baz d
} -result [json normalize {
	{
		"foo":		1,
		"bar":		42.5,
		//"baz":		1e6,
		"quux":		66,
		"octal":	63,
		"space":	42
	}
}]
#>>>
bench template-3.1 {Test templated doc creation, including numbers, json set on result} -setup { #<<<
	set foo		1
	set bar		42.5
	set baz		1e6
	set quux	0x42
	set octal	077
	set space	" 42"

	set d {
		foo		1
		bar		42.5
		baz		1e6
		quux	0x42
		octal	077
		space	" 42"
	}
} -compare {
	template_string {
		set j	[json template_string {
			{
				"foo":		"~N:foo",
				"bar":		"~N:bar",
				//"baz":		"~N:baz",
				"quux":		"~N:quux",
				"octal":	"~N:octal",
				"space":	"~N:space"
			}
		}]
		json set j new null
	}

	template_string_dict {
		set j	[json template_string {
			{
				"foo":		"~N:foo",
				"bar":		"~N:bar",
				//"baz":		"~N:baz",
				"quux":		"~N:quux",
				"octal":	"~N:octal",
				"space":	"~N:space"
			}
		} $d]
		json set j new null
	}

	template {
		set j [json template {
			{
				"foo":		"~N:foo",
				"bar":		"~N:bar",
				//"baz":		"~N:baz",
				"quux":		"~N:quux",
				"octal":	"~N:octal",
				"space":	"~N:space"
			}
		}]
		json set j new null
	}

	template_dict {
		set j [json template {
			{
				"foo":		"~N:foo",
				"bar":		"~N:bar",
				//"baz":		"~N:baz",
				"quux":		"~N:quux",
				"octal":	"~N:octal",
				"space":	"~N:space"
			}
		} $d]
		json set j new null
	}
} -cleanup {
	unset -nocomplain foo bar baz d
} -result [json normalize {
	{
		"foo":		1,
		"bar":		42.5,
		//"baz":		1e6,
		"quux":		66,
		"octal":	63,
		"space":	42,
		"new":		null
	}
}]
#>>>
}
main

# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4

#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated by GNU Autoconf 2.63 for rl_json 0.11.0.
#
# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
# 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.
## --------------------- ##
## M4sh Initialization.  ##

MFLAGS=
MAKEFLAGS=
SHELL=${CONFIG_SHELL-/bin/sh}

# Identity of this package.
PACKAGE_NAME='rl_json'
PACKAGE_TARNAME='rl_json'
PACKAGE_VERSION='0.11.0'
PACKAGE_STRING='rl_json 0.11.0'
PACKAGE_BUGREPORT=''

# Factoring default headers for most tests.
ac_includes_default="\
#include <stdio.h>
#ifdef HAVE_SYS_TYPES_H
# include <sys/types.h>

PACKAGE_NAME
PATH_SEPARATOR
SHELL'
ac_subst_files=''
ac_user_opts='
enable_option_checking
with_tcl
enable_ensemble
enable_dedup
with_tclinclude
enable_threads
enable_shared
enable_64bit
enable_64bit_vis
enable_rpath
enable_wince

#
# Report the --help message.
#
if test "$ac_init_help" = "long"; then
  # Omit some internal or obsolete options to make the list less imposing.
  # This message is too long to be a string in the A/UX 3.1 sh.
  cat <<_ACEOF
\`configure' configures rl_json 0.11.0 to adapt to many kinds of systems.

Usage: $0 [OPTION]... [VAR=VALUE]...

To assign environment variables (e.g., CC, CFLAGS...), specify them as
VAR=VALUE.  See below for descriptions of some of the useful variables.

Defaults for the options are specified in brackets.

  cat <<\_ACEOF
_ACEOF
fi

if test -n "$ac_init_help"; then
  case $ac_init_help in
     short | recursive ) echo "Configuration of rl_json 0.11.0:";;
   esac
  cat <<\_ACEOF

Optional Features:
  --disable-option-checking  ignore unrecognized --enable/--with options
  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]
  --enable-ensemble       Provide the json command using a proper ensemble,
                          otherwise handle the subcommand dispatch internally
                          (default: no)
  --enable-dedup          Parsing JSON involves allocating a lot of small
                          string Tcl_Objs, many of which are duplicates. This
                          mechanism helps reduce that duplication (default:
                          yes)
  --enable-threads        build with threads
  --enable-shared         build and link with shared libraries (default: on)
  --enable-64bit          enable 64bit support (default: off)
  --enable-64bit-vis      enable 64bit Sparc VIS support (default: off)
  --disable-rpath         disable rpath support (default: on)
  --enable-wince          enable Win/CE support (where applicable)
  --enable-symbols        build with debugging symbols (default: off)

    cd "$ac_pwd" || { ac_status=$?; break; }
  done
fi

test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
  cat <<\_ACEOF
rl_json configure 0.11.0
generated by GNU Autoconf 2.63

Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This configure script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it.
_ACEOF
  exit
fi
cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.

It was created by rl_json $as_me 0.11.0, which was
generated by GNU Autoconf 2.63.  Invocation command line was

  $ $0 $@

_ACEOF
exec 5>>config.log
{

	# Let the user call this, because if it triggers, they will
	# need a compat/strtod.c that is correct.  Users can also
	# use Tcl_GetDouble(FromObj) instead.
	#TEA_BUGGY_STRTOD
    fi


# Check for feature toggles

	#trap 'echo "val: (${enable_ensemble+set}), ensemble_ok: ($ensemble_ok), ensemble: ($ENSEMBLE)"' DEBUG
	{ $as_echo "$as_me:$LINENO: checking whether to provide the json command as an ensemble" >&5
$as_echo_n "checking whether to provide the json command as an ensemble... " >&6; }
	# Check whether --enable-ensemble was given.
if test "${enable_ensemble+set}" = set; then
  enableval=$enable_ensemble; ensemble_ok=$enableval
else
  ensemble_ok=no
fi


	if test "$ensemble_ok" = "yes" -o "${ENSEMBLE}" = 1; then
		ENSEMBLE=1
		{ $as_echo "$as_me:$LINENO: result: yes" >&5
$as_echo "yes" >&6; }
	else
		ENSEMBLE=0
		{ $as_echo "$as_me:$LINENO: result: no" >&5
$as_echo "no" >&6; }
	fi


cat >>confdefs.h <<_ACEOF
#define ENSEMBLE $ENSEMBLE
_ACEOF

	#trap '' DEBUG


	#trap 'echo "val: (${enable_dedup+set}), dedup_ok: ($dedup_ok), DEDUP: ($DEDUP)"' DEBUG
	{ $as_echo "$as_me:$LINENO: checking whether to use a string deduplication mechanism for short strings" >&5
$as_echo_n "checking whether to use a string deduplication mechanism for short strings... " >&6; }
	# Check whether --enable-dedup was given.
if test "${enable_dedup+set}" = set; then
  enableval=$enable_dedup; dedup_ok=$enableval
else
  dedup_ok=yes
fi


	if test "$dedup_ok" = "yes" -o "${DEDUP}" = 1; then
		DEDUP=1
		{ $as_echo "$as_me:$LINENO: result: yes" >&5
$as_echo "yes" >&6; }
	else
		DEDUP=0
		{ $as_echo "$as_me:$LINENO: result: no" >&5
$as_echo "no" >&6; }
	fi


cat >>confdefs.h <<_ACEOF
#define DEDUP $DEDUP
_ACEOF

	#trap '' DEBUG


#-----------------------------------------------------------------------
# __CHANGE__
# Specify the C source files to compile in TEA_ADD_SOURCES,
# public headers that need to be installed in TEA_ADD_HEADERS,
# stub library C source files to compile in TEA_ADD_STUB_SOURCES,
# and runtime Tcl library files in TEA_ADD_TCL_SOURCES.
# This defines PKG(_STUB)_SOURCES, PKG(_STUB)_OBJECTS, PKG_HEADERS
# and PKG_TCL_SOURCES.
#-----------------------------------------------------------------------


    vars="parser.c rl_json.c json_types.c dedup.c api.c rl_jsonStubInit.c"
    for i in $vars; do
	case $i in
	    \$*)
		# allow $-var names
		PKG_SOURCES="$PKG_SOURCES $i"
		PKG_OBJECTS="$PKG_OBJECTS $i"
		;;

		;;
	esac
    done




    vars="generic/rl_jsonDecls.h generic/rl_json.h"
    for i in $vars; do
	# check for existence, be strict because it is installed
	if test ! -f "${srcdir}/$i" ; then
	    { { $as_echo "$as_me:$LINENO: error: could not find header file '${srcdir}/$i'" >&5
$as_echo "$as_me: error: could not find header file '${srcdir}/$i'" >&2;}
   { (exit 1); exit 1; }; }
	fi

# Add pkgIndex.tcl if it is generated in the Makefile instead of ./configure
# and change Makefile.in to move it from CONFIG_CLEAN_FILES to BINARIES var.
#
# A few miscellaneous platform-specific items:
# TEA_ADD_* any platform specific compiler/build info here.
#--------------------------------------------------------------------

#CLEANFILES="$CLEANFILES pkgIndex.tcl doc/json.html"
if test "${TEA_PLATFORM}" = "windows" ; then
    # Ensure no empty if clauses
    :
    #TEA_ADD_SOURCES([win/winFile.c])
    #TEA_ADD_INCLUDES([-I\"$(${CYGPATH} ${srcdir}/win)\"])
else
    # Ensure no empty else clauses

	else
	    { $as_echo "$as_me:$LINENO: result: no" >&5
$as_echo "no" >&6; }
	fi
    fi



# Check for required polyfill

	{ $as_echo "$as_me:$LINENO: checking whether we need to polyfill TIP 445" >&5
$as_echo_n "checking whether we need to polyfill TIP 445... " >&6; }
	saved_CFLAGS="$CFLAGS"
	CFLAGS="$CFLAGS $TCL_INCLUDE_SPEC"
	cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */
#include <tcl.h>
int
main ()
{
Tcl_ObjIntRep ir;
  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext
if { (ac_try="$ac_compile"
case "(($ac_try" in
  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
  *) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""
$as_echo "$ac_try_echo") >&5
  (eval "$ac_compile") 2>conftest.er1
  ac_status=$?
  grep -v '^ *+' conftest.er1 >conftest.err
  rm -f conftest.er1
  cat conftest.err >&5
  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); } && {
	 test -z "$ac_c_werror_flag" ||
	 test ! -s conftest.err
       } && test -s conftest.$ac_objext; then
  have_tcl_objintrep=yes
else
  $as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

	have_tcl_objintrep=no
fi

rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
	CFLAGS="$saved_CFLAGS"

	if test "$have_tcl_objintrep" = yes; then

cat >>confdefs.h <<\_ACEOF
#define TIP445_SHIM 0
_ACEOF

		{ $as_echo "$as_me:$LINENO: result: no" >&5
$as_echo "no" >&6; }
	else

cat >>confdefs.h <<\_ACEOF
#define TIP445_SHIM 1
_ACEOF

		{ $as_echo "$as_me:$LINENO: result: yes" >&5
$as_echo "yes" >&6; }
	fi


#--------------------------------------------------------------------
# Set the default compiler switches based on the --enable-symbols option.
#--------------------------------------------------------------------

exec 6>&1

# Save the log message, to keep $[0] and so on meaningful, and to
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
This file was extended by rl_json $as_me 0.11.0, which was
generated by GNU Autoconf 2.63.  Invocation command line was

  CONFIG_FILES    = $CONFIG_FILES
  CONFIG_HEADERS  = $CONFIG_HEADERS
  CONFIG_LINKS    = $CONFIG_LINKS
  CONFIG_COMMANDS = $CONFIG_COMMANDS
  $ $0 $@

$config_files

Report bugs to <bug-autoconf@gnu.org>."

_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_version="\\
rl_json config.status 0.11.0
configured by $0, generated by GNU Autoconf 2.63,
  with options \\"`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\"

Copyright (C) 2008 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."

#!/bin/bash -norc
dnl	This file is an input file used by the GNU "autoconf" program to
dnl	generate the file "configure", which is run during Tcl installation
dnl	to configure the system for the local environment.

#-----------------------------------------------------------------------
# Sample configure.ac for Tcl Extensions.  The only places you should
# need to modify this file are marked by the string __CHANGE__
#-----------------------------------------------------------------------

#-----------------------------------------------------------------------
# __CHANGE__
# Set your package name and version numbers here.
#
# This initializes the environment with PACKAGE_NAME and PACKAGE_VERSION
# set as provided.  These will also be added as -D defs in your Makefile
# so you can encode the package version directly into the source files.
# This will also define a special symbol for Windows (BUILD_<PACKAGE_NAME>
# so that we create the export library with the dll.
#-----------------------------------------------------------------------

AC_PREREQ(2.61)
AC_INIT([rl_json], [0.11.0])

#--------------------------------------------------------------------
# Call TEA_INIT as the first TEA_ macro to set up initial vars.
# This will define a ${TEA_PLATFORM} variable == "unix" or "windows"
# as well as PKG_LIB_FILE and PKG_STUB_LIB_FILE.
#--------------------------------------------------------------------

# Standard compiler checks.
# This sets up CC by using the CC env var, or looks for gcc otherwise.
# This also calls AC_PROG_CC and a few others to create the basic setup
# necessary to compile executables.
#-----------------------------------------------------------------------

TEA_SETUP_COMPILER

# Check for feature toggles
ENABLE_ENSEMBLE
ENABLE_DEDUP

#-----------------------------------------------------------------------
# __CHANGE__
# Specify the C source files to compile in TEA_ADD_SOURCES,
# public headers that need to be installed in TEA_ADD_HEADERS,
# stub library C source files to compile in TEA_ADD_STUB_SOURCES,
# and runtime Tcl library files in TEA_ADD_TCL_SOURCES.
# This defines PKG(_STUB)_SOURCES, PKG(_STUB)_OBJECTS, PKG_HEADERS
# and PKG_TCL_SOURCES.
#-----------------------------------------------------------------------

TEA_ADD_SOURCES([parser.c rl_json.c json_types.c dedup.c api.c rl_jsonStubInit.c])
TEA_ADD_HEADERS([generic/rl_jsonDecls.h generic/rl_json.h])
TEA_ADD_INCLUDES([])
TEA_ADD_LIBS([])
TEA_ADD_CFLAGS([])
TEA_ADD_STUB_SOURCES([rl_jsonStubLib.c])
TEA_ADD_TCL_SOURCES([])

#--------------------------------------------------------------------
# __CHANGE__
#
# You can add more files to clean if your extension creates any extra
# files by extending CLEANFILES.
# Add pkgIndex.tcl if it is generated in the Makefile instead of ./configure
# and change Makefile.in to move it from CONFIG_CLEAN_FILES to BINARIES var.
#
# A few miscellaneous platform-specific items:
# TEA_ADD_* any platform specific compiler/build info here.
#--------------------------------------------------------------------

#CLEANFILES="$CLEANFILES pkgIndex.tcl doc/json.html"
if test "${TEA_PLATFORM}" = "windows" ; then
    # Ensure no empty if clauses
    :
    #TEA_ADD_SOURCES([win/winFile.c])
    #TEA_ADD_INCLUDES([-I\"$(${CYGPATH} ${srcdir}/win)\"])
else
    # Ensure no empty else clauses

#--------------------------------------------------------------------
# This macro figures out what flags to use with the compiler/linker
# when building shared/static debug/optimized objects.  This information
# can be taken from the tclConfig.sh file, but this figures it all out.
#--------------------------------------------------------------------

TEA_CONFIG_CFLAGS

# Check for required polyfill
TIP445

#--------------------------------------------------------------------
# Set the default compiler switches based on the --enable-symbols option.
#--------------------------------------------------------------------

TEA_ENABLE_SYMBOLS

'\"
'\" Copyright (c) 2015 Ruby Lane
'\"
'\" See the file "LICENSE" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH json n 0.11.0 rl_json "RubyLane/JSON Package Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
json \- Parse, manipulate and produce JSON documents 
.SH SYNOPSIS
.nf
\fBpackage require rl_json\fR ?\fB0.11.0\fR? 

\fBjson get \fIjsonValue\fR ?\fIkey ...\fR?
\fBjson extract \fIjsonValue\fR ?\fIkey ...\fR?
\fBjson exists \fIjsonValue\fR ?\fIkey ...\fR?
\fBjson set \fIjsonVariableName\fR ?\fIkey ...\fR? \fIvalue\fR
\fBjson unset \fIjsonVariableName\fR ?\fIkey ...\fR?
\fBjson foreach \fIvarlist1 jsonValue1\fR ?\fIvarlist2 jsonValue2 ...\fR? \fIscript\fR
\fBjson lmap \fIvarlist1 jsonValue1\fR ?\fIvarlist2 jsonValue2 ...\fR? \fIscript\fR
\fBjson amap \fIvarlist1 jsonValue1\fR ?\fIvarlist2 jsonValue2 ...\fR? \fIscript\fR
\fBjson omap \fIvarlist1 jsonValue1\fR ?\fIvarlist2 jsonValue2 ...\fR? \fIscript\fR
\fBjson string \fIvalue\fR
\fBjson number \fIvalue\fR
\fBjson boolean \fIvalue\fR
\fBjson object \fI?key value ?key value ...??\fR
\fBjson array \fIelem ...\fR
\fBjson bool \fIvalue\fR
\fBjson normalize \fIjsonValue\fR
\fBjson pretty \fIjsonValue\fR

\fBjson template \fIjsonValue\fR ?\fIdictionary\fR?

\fBjson isnull \fIjsonValue\fR ?\fIkey ...\fR?
\fBjson type \fIjsonValue\fR ?\fIkey ...\fR?
\fBjson length \fIjsonValue\fR ?\fIkey ...\fR?
\fBjson keys \fIjsonValue\fR ?\fIkey ...\fR?
\fBjson decode \fIbytes\fR ?\fIencoding\fR?
\fBjson valid ?\fB-extensions\fR \fIextensionlist\fR? ?\fB-details\fR \fIdetailsvar\fR? \fIjsonValue\fR
.fi
.BE
.SH DESCRIPTION
.PP
This package adds a command \fBjson\fR to the interpreter, and defines a new
Tcl_Obj type to store the parsed JSON document.  The \fBjson\fR command
directly manipulates values whose string representation is valid JSON, in a
similar way to how the \fBdict\fR command directly manipulates values whose
string representation is a valid dictionary.  It is similar to \fBdict\fR in
performance.
.TP
\fBjson get \fIjsonValue\fR ?\fIkey ...\fR?
.
Extract the value of a portion of the \fIjsonValue\fR, returns the closest
native Tcl type (other than JSON) for the extracted portion. The \fIkey ...\fR
arguments are a path, as described in \fBPATHS\fR below.
'\" TODO: describe what happens with a null
.TP







\fBjson extract \fIjsonValue\fR ?\fIkey ...\fR?
.
Extract the value of a portion of the \fIjsonValue\fR, returns the JSON
fragment. The \fIkey ...\fR arguments are a path, as described in \fBPATHS\fR
below.
.TP
\fBjson exists \fIjsonValue\fR ?\fIkey ...\fR?
.
Tests whether the supplied key path (see \fBPATHS\fR below) resolves to
something that exists in \fIjsonValue\fR (i.e., that it can be used with
\fBjson get\fR without error) and is not null.  Returns false if the value
named by the path \fIkey ...\fR is null.
.TP
\fBjson set \fIjsonVariableName\fR ?\fIkey ...\fR? \fIvalue\fR
.
Updates the JSON value stored in the variable \fIjsonVariableName\fR,
replacing the value referenced by \fIkey ...\fR (a path as described in
\fBPATHS\fR below) with the JSON value \fIvalue\fR.  If \fIvalue\fR is
a valid JSON as given by the JSON grammar, it is added as that JSON type,
otherwise it is converted to a JSON string.  Thus the following are equivalent
(modulo efficiency):

.CS
 json set doc foo [json string baz]
 json set doc bar [json number 123]
 json set doc baz [json boolean true]

 #------------------------------------------
 json set doc foo baz
 json set doc bar 123
 json set doc baz true
.CE

Watch out for unintended behaviour if the value might look like a boolean or
number but not meet the JSON grammar for those types, in which case the value
is converted to a JSON string:

.CS
 json set doc foo [json boolean yes]
 # Key "foo" contains the JSON boolean value "true"

 json set doc foo yes
 # Key "foo" contains the JSON string value "yes"
.CE

Constructing the values using [\fBjson \fItype\fR] forces the conversion to
the specified JSON type, or throws an exception if that can't be done.
Which is more efficent will depend on the situation:

.CS
 set doc {[]}
 for {set i 0} {$i < 100} {incr i} {
 	json set doc end+1 [json boolean true]	;# 1
 	json set doc end+1 true				;# 2
 }
 # 2 will be faster since "true" will be stored as a literal, and converted
 # to a JSON boolean.  Each loop iteration will just append another reference
 # to this static value to the array, whereas 1 will call [json boolean] each
 # iteration.
 
 set doc {[]}
 for {set i 0} {$i < 100} {incr i} {
 	json set doc end+1 [json string false$i]	;# 1
 	json set doc end+1 false$i				;# 2
 }
 # 1 will be faster since [json string] knows what the type is and directly
 # creates the new element as that type.  2 Needs to parse the string to
 # determine the type.
.CE
.TP
\fBjson unset \fIjsonVariableName\fR ?\fIkey ...\fR?
.
Updates the JSON value stored in the variable \fIjsonVariableName\fR, removing
the value referenced by \fIkey ...\fR, a path as described in \fBPATHS\fR
below.  If the path names a entry in an object then that key is removed from the
object.  If the path names an element in an array, that element is removed
and all later elements are moved up.





.TP
\fBjson template \fIjsonValue\fR ?\fIdictionary\fR?
.
Return a JSON value by interpolating the values from \fIdictionary\fR into the
template, or from variables in the current scope if \fIdictionary\fR is not
supplied, in the manner described in the section \fBTEMPLATES\fR.
.TP
\fBjson string \fIvalue\fR
.
Return a JSON string with the value \fIvalue\fR.
.TP
\fBjson number \fIvalue\fR
.
Return a JSON number with the value \fIvalue\fR.
.TP
\fBjson boolean \fIvalue\fR
.
Return a JSON boolean with the value \fIvalue\fR.  Any of the forms accepted by
Tcl_GetBooleanFromObj are accepted and normalized.
.TP
\fBjson object \fI?key value ?key value ...??\fR -or- \fBjson object \fIpacked_value\fR
.
Return a JSON object with the each of the keys and values given.  \fIvalue\fR is a list
of two elements, the first being the type {string, number, boolean, null, object, array, json},
and the second being the value.  The alternate syntax \fBjson object \fIpacked_value\fR
takes the list of keys and values as a single arg instead of a list of args, but is
otherwise the same.
.TP
\fBjson array \fI?elem ...?\fR
.
Return a JSON array containing each of the elements given.  \fIelem\fR is a list
of two elements, the first being the type {string, number, boolean, null, object, array, json},
and the second being the value.
.TP
\fBjson foreach \fIvarList1 jsonValue1\fR ?\fIvarList2 jsonValue2 ...\fR? \fIscript\fR
.
Evaluate \fIscript\fR in a loop in a similar way to the \fBforeach\fR command.
In each iteration, the values stored in the iterator variables in each
\fIvarList\fR are the JSON fragments from \fIjsonValue\fR. This command
supports iterating over JSON arrays and JSON objects.  In the JSON object
case, the corresponding \fIvarList\fR must be a two element list, with the
first specifiying the variable to hold the key and the second the value.  In
the JSON array case, the rules are the same as the \fBforeach\fR command.
.TP
\fBjson lmap \fIvarList1 jsonValue1\fR ?\fIvarList2 jsonValue2 ...\fR? \fIscript\fR
.



As for \fBjson foreach\fR, except that it is collecting; the result from each
evaluation of \fIscript\fR is added to a Tcl list and returned as the result
of the \fBjson lmap\fR command.  If the \fIscript\fR results in a TCL_CONTINUE
code (e.g., the script does \fBcontinue\fR), that iteration is skipped and no
element is added to the result list.  If it results in TCL_BREAK (e.g., the
script does \fBbreak\fR) the iterations are stopped and the results
accumulated so far are returned.
.TP
\fBjson amap \fIvarList1 jsonValue1\fR ?\fIvarList2 jsonValue2 ...\fR? \fIscript\fR
.
As for \fBjson lmap\fR, but the result is a JSON array rather than a list.  If
the result of each iteration is a JSON value it is added to the array as-is,
otherwise it is converted to a JSON string.
.TP
\fBjson omap \fIvarList1 jsonValue1\fR ?\fIvarList2 jsonValue2 ...\fR? \fIscript\fR
.
As for \fBjson lmap\fR, but the result is a JSON object rather than a list.
The result of each iteration must be a dictionary (or a list of 2n elements,
including n = 0).  Tcl_ObjType snooping is done to ensure that the iteration
over the result is efficient for both dict and list cases.
Each entry in the dictionary will be added to the result object.  If the value
for each key in the iteration result is a JSON value it is added to the array
as-is, otherwise it is converted to a JSON string.
.TP
\fBjson isnull \fIjsonVariableName\fR ?\fIkey ...\fR?
.
Return a boolean indicating whether the named JSON value is null.
.TP
\fBjson type \fIjsonVariableName\fR ?\fIkey ...\fR?
.
Return the type of the named JSON value, one of "object", "array", "string",
"number", "boolean" or "null".
.TP
\fBjson length \fIjsonVariableName\fR ?\fIkey ...\fR?
.
Return the length of the of the named JSON array, number of entries in the
named JSON object, or number of characters in the named JSON string.  Other
value types aren't supported.
.TP
\fBjson keys \fIjsonVariableName\fR ?\fIkey ...\fR?
.
Return the keys in the of the named JSON object, found by following the path of \fIkey\fRs.
.TP
\fBjson normalize \fIjsonValue\fR
.
Return a
.QW normalized
version of the input \fIjsonValue\fR, i.e., with all optional whitespace
trimmed.
.TP
\fBjson pretty \fIjsonValue\fR
.
Returns a pretty-printed string representation of \fIjsonValue\fR.  Useful for
debugging or inspecting the structure of JSON data.
.TP
\fBjson decode \fIbytes\fR ?\fIencoding\fR?
.
Rl_json operates on characters, as returned from Tcl's Tcl_GetStringFromObj,
not raw bytes, so considerations of encoding are strictly outside of its scope
(other than ignoring a byte order mark if the string starts with one).  The
JSON RFC lays out some behaviour for conforming implementations regarding
character encoding, and ensuring that an application using rl_json meets that
standard would be up to the application.  Some aspects are not straightforward,
so rl_json provides this utility subcommand that takes binary data in \fIbytes\fR
and returns a character string according to the RFC specified behaviour.  If
the optional \fIencoding\fR argument is given, that encoding will be used to
interpret \fIbytes\fR.  The supported encodings are those specified in the RFC:
utf-8, utf-16le, utf-16be, utf-32le, utf-32be.  If the string starts with a BOM
(byte order mark (U+FFFE)), and no encoding is given, it will be determined
from the encoding of the BOM.  All the encodings listed are supported, even if
Tcl lacks support for the utf-16 and utf-32 encodings natively.  However,
without native support the conversion will be slow.

This might look something like this in an application:

.CS
 proc readjson file {
 	set h [open $file rb]	;# Note that the file is opened in binary mode - no encoding
 	try {
 		json decode [read $h]
 	} finally {
 		close $h
 	}
 }
.CE
.TP
\fBjson valid\fR ?\fB-extensions\fR \fIextensionlist\fR? ?\fB-details\fR \fIdetails\fR? \fIjsonValue\fR
.
Validate \fBjsonValue\fR against the JSON grammar, returning true of it
conforms and false otherwise.  A list of extensions to accept can be supplied
with \fB-extensions\fR, with only one currently supported extension:
\fBcomments\fR, which accepts JSON documents containing \fB// foo\fR and \fB/*
foo */\fR style comments anywhere whitespace would be valid.  To reject
documents containing comments, set \fIextensionlist\fR to {}.

Validation using this subcommand is about 3 times faster than parsing and
catching a parsing exception, and it allows strict validation against the RFC
without comments.

If validation fails and \fB-details\fR \fIdetailsvar\fR is supplied, the variable
\fIdetailsvar\fR is set to a dictionary containing the keys:
.RS 10
.IP \fBerrmsg\fR 10
A reason for the failure.
.IP \fBdoc\fR 10
The document that failed validation
.IP \fBchar_ofs\fR 10
The character offset into \fBdoc\fR that caused validation to fail.
.RE
.SH PATHS
.PP
Several of the commands (e.g., \fBjson get\fR, \fBjson exists\fR, \fBjson
set\fR and \fBjson unset\fR) accept a path specification that names some
subset of the supplied \fIjsonValue\fR.  The rules are similar to the
equivalent concept in the \fBdict\fR command, except that the paths used by
\fBjson\fR allow indexing into JSON arrays by the integer key (or a string
matching the regex
.QW "^end(-[0-9]+)?$" ).




































.SH TEMPLATES
.PP
The command \fBjson template\fR generates JSON documents by interpolating
values into a template from a supplied dictionary or variables in the current
call frame, a flexible mechanism for generating complex documents.  The
templates are valid JSON documents containing string values which match the
regex

.CE
.PP
Incrementally append an element to an array (similar to \fBdict lappend\fR):
.PP
.CS
 set doc {{"foo":[]}}
 for {set i 0} {$i < 4} {incr i} {
     json set doc foo end+1 [json string "elem: $i"]
 }
 # $doc is {"foo":["elem 0","elem 1","elem 2","elem 3"]}
.CE
.PP
Similar to the above, but prepend the elements instead:
.PP
.CS
 set doc {{"foo":[]}}
 for {set i 0} {$i < 4} {incr i} {
     json set doc foo -1 [json string "elem: $i"]
 }
 # $doc is {"foo":["elem 3","elem 2","elem 1","elem 0"]}
.CE
.PP
Trim an element out of an array:
.PP
.CS

#!/usr/bin/env tclsh

# Doesn't work.  It should, but github is serving the binary .json files as utf-8, which breaks all the carefully
# crafted encoding tests

# Dependencies:
#	rl_json:		https://github.com/RubyLane/rl_json
#	parse_args: 	https://github.com/RubyLane/parse_args
#	rl_http:		https://github.com/RubyLane/rl_http
#	urlencode:		copied to support/
#	uri:			tcllib
#	Thread:			https://core.tcl-lang.org/thread
#	tls:			https://core.tcl-lang.org/tcltls/index

set here	[file dirname [file normalize [info script]]]

tcl::tm::path add [file join $here support]
lappend auto_path $here

package require rl_json		;# yeah...
package require rl_http
package require parse_args
package require urlencode

interp alias {} json {} ::rl_json::json
interp alias {} parse_args {} ::parse_args::parse_args

proc http {method url args} { #<<<
	parse_args $args {
		-log				{-default {{lvl msg} {}}}
		-if_modified_since	{-# {seconds since 1970-01-01 00:00:00 UTC}}
	}

	set headers	{}

	if {[info exists if_modified_since]} {
		lappend headers If-Modified-Since [clock format $if_modified_since -format {%a, %d %b %Y %H:%M:%S GMT} -gmt 1]
		#puts "If-Modified-Since: [lindex $headers end]"
	}

	while {[incr tries] <= 3} {
		try {
			apply $log notice "Fetching $method $url"
			rl_http instvar h $method $url -headers $headers
		} on error {errmsg options} {
			throw [list HTTP RL_HTTP {*}[dict get $options -errorcode]] $errmsg
		}

		switch -glob -- [$h code] {
			2*               {
			#puts "Headers:\n\t[join [lmap {k v} [$h headers] {format {%s: %s} $k $v}] \n\t]"
				return [$h body]
			}
			304		         {throw [list HTTP CODE [$h code]] "Not modified"}
			301 - 302 - 307  {set url [lindex [dict get [$h headers] location] 0]}
			403 {
				if {[dict exists [$h headers] x-ratelimit-limit]} { # Rate limiting <<<
					set limit		[lindex [dict get [$h headers] x-ratelimit-limit] 0]
					set remaining	[lindex [dict get [$h headers] x-ratelimit-remaining] 0]
					set reset		[lindex [dict get [$h headers] x-ratelimit-reset] 0]
					throw [list HTTP RATELIMIT $reset $limit $remaining] "Rate limited until [clock format $reset]"
					#>>>
				}

				throw [list HTTP CODE [$h code]] [$h body]
			}
			503 {
				apply $log warning "Got 503 error, waiting and trying again"
				after 2000
			}
			default {
				throw [list HTTP CODE [$h code]] "Error fetching $method $url: [$h code]\n[$h body]"
			}
		}
	}

	throw [list HTTP TOO_MANY_TRIES [expr {$tries-1}]] "Ran out of patience fetching $method $endoint after $tries failures"
}

#>>>

namespace eval ::github {
	namespace export *
	namespace ensemble create -prefixes no

	proc endpoint args { #<<<
		parse_args $args {
			-owner		{-required}
			-repo		{-required}
			args		{-name path_parts}
		}

		string cat \
			https://api.github.com/repos/ \
			[urlencode rfc_urlencode -part path -- $owner] \
			/ \
			[urlencode rfc_urlencode -part path -- $repo] \
			/contents/ \
			[join [lmap e $path_parts {urlencode rfc_urlencode -part path -- $e}] /]
	}

	#>>>

	proc api {method args} { #<<<
		set endpoint	[github endpoint {*}$args]

		http $method $endpoint
	}

	#>>>
}

proc writetext {fn data} { #<<<
	set h	[open $fn w]
	try {
		puts -nonewline $h $data
	} finally {
		close $h
	}
}

#>>>
proc writebin {fn data} { #<<<
	set h	[open $fn wb]
	try {
		puts -nonewline $h $data
	} finally {
		close $h
	}
}

#>>>

proc fetch_file {dest file} { #<<<
	set fn	[file join $dest [json get $file name]]
	if {[file exists $fn]} {
		set mtime	[file mtime $fn]
		try {
			puts -nonewline "Fetching [json get $file name] -if_modified_since $mtime"
			http GET [json get $file download_url] -if_modified_since $mtime
		} on ok contents {
			puts " [string length $contents] bytes"
			writebin [file join $dest [json get $file name]] $contents
		} trap {HTTP CODE 304} {} {
			puts " not modified"
			return
		} on error {errmsg options} {
			puts " Error: $errmsg"
		}
	} else {
		try {
			puts -nonewline "Fetching [json get $file name]"
			http GET [json get $file download_url]
		} on ok contents {
			puts " [string length $contents] bytes"
			writebin [file join $dest [json get $file name]] $contents
		} on error {errmsg options} {
			puts " Error: $errmsg"
		}
	}
}

#>>>

set dest	[file join $here tests JSONTestSuite test_parsing]
file mkdir $dest

set listing	[github api GET -owner nst -repo JSONTestSuite test_parsing]
#puts [json pretty $listing]
json foreach file $listing {
	fetch_file $dest $file
}

set dest	[file join $here tests JSONTestSuite test_transform]
file mkdir $dest

set listing	[github api GET -owner nst -repo JSONTestSuite test_transform]
#puts [json pretty $listing]
json foreach file $listing {
	fetch_file $dest $file
}

# vim: foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4

#include "rl_jsonInt.h"
#include "parser.h"

Tcl_Obj* JSON_NewJSONObj(Tcl_Interp* interp, Tcl_Obj* from) //{{{
{
	return as_json(interp, from);
}

//}}}
int JSON_NewJStringObj(Tcl_Interp* interp, Tcl_Obj* string, Tcl_Obj** new) //{{{
{
	replace_tclobj(new, JSON_NewJvalObj(JSON_STRING, string));

	return TCL_OK;
}

//}}}
int JSON_NewJNumberObj(Tcl_Interp* interp, Tcl_Obj* number, Tcl_Obj** new) //{{{
{
	Tcl_Obj*			forced = NULL;
	struct interp_cx*	l = Tcl_GetAssocData(interp, "rl_json", NULL);

	TEST_OK(force_json_number(interp, l, number, &forced));
	replace_tclobj(new, JSON_NewJvalObj(JSON_NUMBER, forced));
	release_tclobj(&forced);

	return TCL_OK;
}

//}}}
int JSON_NewJBooleanObj(Tcl_Interp* interp, Tcl_Obj* boolean, Tcl_Obj** new) //{{{
{
	struct interp_cx*	l = Tcl_GetAssocData(interp, "rl_json", NULL);
	int					bool;

	TEST_OK(Tcl_GetBooleanFromObj(interp, boolean, &bool));
	replace_tclobj(new, bool ? l->json_true : l->json_false);

	return TCL_OK;
}

//}}}
int JSON_NewJNullObj(Tcl_Interp* interp, Tcl_Obj* *new) //{{{
{
	struct interp_cx*	l = Tcl_GetAssocData(interp, "rl_json", NULL);

	replace_tclobj(new, l->json_null);

    return TCL_OK;
}

//}}}
int JSON_NewJObjectObj(Tcl_Interp* interp, Tcl_Obj** new) //{{{
{
	struct interp_cx*	l = Tcl_GetAssocData(interp, "rl_json", NULL);

	replace_tclobj(new, JSON_NewJvalObj(JSON_OBJECT, l->tcl_empty_dict));

	return TCL_OK;
}

//}}}
int JSON_NewJArrayObj(Tcl_Interp* interp, int objc, Tcl_Obj* objv[], Tcl_Obj** new) //{{{
{
	struct interp_cx*	l = Tcl_GetAssocData(interp, "rl_json", NULL);

	if (objc == 0) {
		replace_tclobj(new, JSON_NewJvalObj(JSON_OBJECT, l->tcl_empty_list));
	} else {
		int		i;

		for (i=0; i<objc; i++) TEST_OK(JSON_ForceJSON(interp, objv[i]));

		replace_tclobj(new, JSON_NewJvalObj(JSON_OBJECT, Tcl_NewListObj(objc, objv)));
	}

	return TCL_OK;
}

//}}}
int JSON_NewTemplateObj(Tcl_Interp* interp, enum json_types type, Tcl_Obj* key, Tcl_Obj** new) //{{{
{
	if (!type_is_dynamic(type)) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("Requested type is not a valid template type: %s", type_names_int[type]));
		return TCL_ERROR;
	}

	replace_tclobj(new, JSON_NewJvalObj(type, key));

	return TCL_OK;	
}

//}}}
int JSON_ForceJSON(Tcl_Interp* interp, Tcl_Obj* obj) // Force a conversion to a JSON objtype, or throw an exception {{{
{
	Tcl_ObjIntRep*	ir;
	enum json_types	type;

	TEST_OK(JSON_GetIntrepFromObj(interp, obj, &type, &ir));

	return TCL_OK;
}

//}}}

enum json_types JSON_GetJSONType(Tcl_Obj* obj) //{{{
{
	Tcl_ObjIntRep*	ir = NULL;
	enum json_types	t;

	for (t=JSON_OBJECT; t<JSON_TYPE_MAX && ir==NULL; t++)
		ir = Tcl_FetchIntRep(obj, g_objtype_for_type[t]);

	return (ir == NULL) ? JSON_UNDEF : t-1;
}

//}}}
int JSON_GetObjFromJStringObj(Tcl_Interp* interp, Tcl_Obj* jstringObj, Tcl_Obj** stringObj) //{{{
{
	enum json_types	type;
	Tcl_Obj*		val = NULL;

	TEST_OK(JSON_GetJvalFromObj(interp, jstringObj, &type, &val));

	if (type_is_dynamic(type)) {
		replace_tclobj(stringObj, Tcl_ObjPrintf("%s%s", get_dyn_prefix(type), Tcl_GetString(val)));
		return TCL_OK;
	} else if (type == JSON_STRING) {
		replace_tclobj(stringObj, val);
		return TCL_OK;
	} else {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("Asked for string from json string but supplied json %s", get_type_name(type)));
		return TCL_ERROR;
	}
}

//}}}
int JSON_GetObjFromJNumberObj(Tcl_Interp* interp, Tcl_Obj* jnumberObj, Tcl_Obj** numberObj) //{{{
{
	enum json_types	type;
	Tcl_Obj*		val = NULL;

	TEST_OK(JSON_GetJvalFromObj(interp, jnumberObj, &type, &val));

	if (type != JSON_NUMBER) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("Asked for number from json number but supplied json %s", get_type_name(type)));
		return TCL_ERROR;
	}

	replace_tclobj(numberObj, val);

	return TCL_OK;
}

//}}}
int JSON_GetObjFromJBooleanObj(Tcl_Interp* interp, Tcl_Obj* jbooleanObj, Tcl_Obj** booleanObj) //{{{
{
	enum json_types	type;
	Tcl_Obj*		val = NULL;

	TEST_OK(JSON_GetJvalFromObj(interp, jbooleanObj, &type, &val));

	if (type != JSON_BOOL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("Asked for boolean from json boolean but supplied json %s", get_type_name(type)));
		return TCL_ERROR;
	}

	replace_tclobj(booleanObj, val);

	return TCL_OK;
}

//}}}
int JSON_JArrayObjAppendElement(Tcl_Interp* interp, Tcl_Obj* arrayObj, Tcl_Obj* elem) //{{{
{
	enum json_types	type;
	Tcl_ObjIntRep*	ir = NULL;
	Tcl_Obj*		val = NULL;

	if (Tcl_IsShared(arrayObj)) {
		// Tcl_Panic?
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("JSON_JArrayObjAppendElement called with shared object"));
		return TCL_ERROR;
	}

	TEST_OK(JSON_GetIntrepFromObj(interp, arrayObj, &type, &ir));

	if (type != JSON_ARRAY) // Turn it into one by creating a new array with a single element containing the old value
		TEST_OK(JSON_SetIntRep(arrayObj, JSON_ARRAY, Tcl_NewListObj(1, &val)));

	val = get_unshared_val(ir);

	TEST_OK(Tcl_ListObjAppendElement(interp, val, as_json(interp, elem)));

	release_tclobj((Tcl_Obj**)&ir->twoPtrValue.ptr2);
	Tcl_InvalidateStringRep(arrayObj);

	return TCL_OK;
}

//}}}
int JSON_JArrayObjAppendList(Tcl_Interp* interp, Tcl_Obj* arrayObj, Tcl_Obj* elems /* a JArrayObj or ListObj */ ) //{{{
{
	enum json_types	type, elems_type;
	Tcl_ObjIntRep*	ir = NULL;
	Tcl_Obj*		val = NULL;
	Tcl_Obj*		elems_val = NULL;
	int				retval = TCL_OK;

	if (Tcl_IsShared(arrayObj)) {
		// Tcl_Panic?
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("JSON_JArrayObjAppendElement called with shared object"));
		return TCL_ERROR;
	}

	TEST_OK(JSON_GetIntrepFromObj(interp, arrayObj, &type, &ir));

	if (type != JSON_ARRAY) // Turn it into one by creating a new array with a single element containing the old value
		TEST_OK(JSON_SetIntRep(arrayObj, JSON_ARRAY, Tcl_NewListObj(1, &val)));

	val = get_unshared_val(ir);

	if (JSON_GetJvalFromObj(interp, elems, &elems_type, &elems_val) == TCL_OK) {
		switch (elems_type) {
			case JSON_ARRAY:	// Given a JSON array, append its elements
				TEST_OK(Tcl_ListObjAppendList(interp, val, elems_val));
				break;

			case JSON_OBJECT:	// Given a JSON object, append its keys as strings and values as whatever they were
				{
					Tcl_DictSearch search;
					Tcl_Obj*		k = NULL;
					Tcl_Obj*		kjstring = NULL;
					Tcl_Obj*		v = NULL;
					int				done;

					TEST_OK(Tcl_DictObjFirst(interp, elems_val, &search, &k, &v, &done));
					for (; !done; Tcl_DictObjNext(&search, &k, &v, &done)) {
						TEST_OK_BREAK(retval, JSON_NewJStringObj(interp, k, &kjstring));
						TEST_OK_BREAK(retval, Tcl_ListObjAppendElement(interp, val, kjstring));
						TEST_OK_BREAK(retval, Tcl_ListObjAppendElement(interp, val, v));
					}
					release_tclobj(&kjstring);
					Tcl_DictObjDone(&search);
				}
				break;

			default:			// elems is JSON, but not a sensible type for this call
				Tcl_SetObjResult(interp, Tcl_ObjPrintf("Could not append elements - not a JSON array, JSON object or list: %s", get_type_name(elems_type)));
				return TCL_ERROR;
		}
	} else {
		TEST_OK(Tcl_ListObjAppendList(interp, val, elems));
	}

	return retval;
}

//}}}
int JSON_SetJArrayObj(Tcl_Interp* interp, Tcl_Obj* obj, const int objc, Tcl_Obj* objv[]) //{{{
{
	enum json_types	type;
	Tcl_ObjIntRep*	ir = NULL;
	Tcl_Obj*		val = NULL;
	int				i, retval = TCL_OK;
	Tcl_Obj**		jov = NULL;
	Tcl_Obj*		newlist = NULL;

	if (Tcl_IsShared(obj)) {
		// Tcl_Panic?
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("JSON_SetJArrayObj called with shared object"));
		return TCL_ERROR;
	}

	jov = ckalloc(sizeof(Tcl_Obj*) * objc);
	for (i=0; i<objc; i++)
		Tcl_IncrRefCount(jov[i] = as_json(interp, objv[i]));

	// Possibly silly optimization: if obj is already a JSON array, call Tcl_SetListObj on its intrep list.
	// All this saves is freeing the old intrep list and creating a fresh one, at the cost of some other overhead
	if (JSON_IsJSON(obj, &type, &ir)) {
		val = get_unshared_val(ir);
		Tcl_SetListObj(val, objc, jov);
	} else {
		replace_tclobj(&newlist, Tcl_NewListObj(objc, jov));
		retval = JSON_SetIntRep(obj, JSON_ARRAY, newlist);
	}

	release_tclobj(&newlist);

	if (jov) {
		for (i=0; i<objc; i++) release_tclobj(&jov[i]);
		ckfree(jov);
		jov = NULL;
	}

	return retval;
}

//}}}
int JSON_JArrayObjGetElements(Tcl_Interp* interp, Tcl_Obj* arrayObj, int* objc, Tcl_Obj*** objv) //{{{
{
	enum json_types	type;
	Tcl_Obj*		val = NULL;

	TEST_OK(JSON_GetJvalFromObj(interp, arrayObj, &type, &val));
	if (type != JSON_ARRAY) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("Expecting a JSON array, but got a JSON %s", get_type_name(type)));
		return TCL_ERROR;
	}
	TEST_OK(Tcl_ListObjGetElements(interp, val, objc, objv));

	return TCL_OK;
}

//}}}
int JSON_JArrayObjIndex(Tcl_Interp* interp, Tcl_Obj* arrayObj, int index, Tcl_Obj** elem) //{{{
{
	enum json_types	type;
	Tcl_Obj*		val = NULL;

	TEST_OK(JSON_GetJvalFromObj(interp, arrayObj, &type, &val));
	if (type != JSON_ARRAY) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("Expecting a JSON array, but got a JSON %s", get_type_name(type)));
		return TCL_ERROR;
	}
	TEST_OK(Tcl_ListObjIndex(interp, val, index, elem));

	return TCL_OK;
}

//}}}
int JSON_JArrayObjReplace(Tcl_Interp* interp, Tcl_Obj* arrayObj, int first, int count, int objc, Tcl_Obj* objv[]) //{{{
{
	enum json_types	type;
	Tcl_Obj*		val = NULL;
	Tcl_Obj**		jov = NULL;
	int				i, retval=TCL_OK;

	TEST_OK(JSON_GetJvalFromObj(interp, arrayObj, &type, &val));
	if (type != JSON_ARRAY) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("Expecting a JSON array, but got a JSON %s", get_type_name(type)));
		return TCL_ERROR;
	}

	jov = ckalloc(sizeof(Tcl_Obj*) * objc);
	for (i=0; i<objc; i++)
		Tcl_IncrRefCount(jov[i] = as_json(interp, objv[i]));

	retval = Tcl_ListObjReplace(interp, val, first, count, objc, jov);

	if (jov) {
		for (i=0; i<objc; i++) release_tclobj(&jov[i]);
		ckfree(jov);
		jov = NULL;
	}

	return retval;
}

//}}}
// TODO: JObject interface, similar to DictObj

int JSON_Get(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path, Tcl_Obj** res) //{{{
{
	int			retval = TCL_OK;
	Tcl_Obj*	jval = NULL;
	Tcl_Obj*	astcl = NULL;

	retval = JSON_Extract(interp, obj, path, &jval);

	if (retval == TCL_OK)
		retval = convert_to_tcl(interp, jval, &astcl);

	if (retval == TCL_OK)
		replace_tclobj(res, astcl);

	release_tclobj(&astcl);
	release_tclobj(&jval);

	return retval;
}

//}}}
int JSON_Extract(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path, Tcl_Obj** res) //{{{
{
	Tcl_Obj*	target = NULL;
	int			retval=TCL_OK;
	Tcl_Obj**	pathv = NULL;
	int			pathc;

	TEST_OK(Tcl_ListObjGetElements(interp, path, &pathc, &pathv));

	if (pathc > 0) {
		TEST_OK(resolve_path(interp, obj, pathv, pathc, &target, 0, 0));
	} else {
		TEST_OK(JSON_ForceJSON(interp, obj));
		replace_tclobj(&target, obj);
	}

	if (retval == TCL_OK)
		replace_tclobj(res, target);

	release_tclobj(&target);

	return retval;
}

//}}}
int JSON_Exists(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path, int* exists) //{{{
{
	struct interp_cx*	l = Tcl_GetAssocData(interp, "rl_json", NULL);
	Tcl_Obj*			target = NULL;
	Tcl_Obj**			pathv = NULL;
	int					pathc;

	TEST_OK(Tcl_ListObjGetElements(interp, path, &pathc, &pathv));

	if (pathc > 0) {
		TEST_OK(resolve_path(interp, obj, pathv, pathc, &target, 1, 0));
		release_tclobj(&target);
		// resolve_path sets the interp result in exists mode
		*exists = (Tcl_GetObjResult(interp) == l->json_true);
		Tcl_ResetResult(interp);
	} else {
		enum json_types	type = JSON_GetJSONType(obj);
		*exists = (type != JSON_UNDEF && type != JSON_NULL);
	}

	return TCL_OK;
}

//}}}
int JSON_Set(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj *path, Tcl_Obj* replacement) //{{{
{
	int				i, pathc;
	enum json_types	type, newtype;
	Tcl_ObjIntRep*	ir = NULL;
	Tcl_Obj*		val = NULL;
	Tcl_Obj*		step;
	Tcl_Obj*		src;
	Tcl_Obj*		target;
	Tcl_Obj*		newval;
	Tcl_Obj*		rep = NULL;
	Tcl_Obj**		pathv = NULL;

	src = Tcl_ObjGetVar2(interp, obj, NULL, 0);
	if (src == NULL) {
		src = Tcl_ObjSetVar2(interp, obj, NULL, JSON_NewJvalObj(JSON_OBJECT, Tcl_NewDictObj()), TCL_LEAVE_ERR_MSG);
	}

	if (Tcl_IsShared(src)) {
		src = Tcl_ObjSetVar2(interp, obj, NULL, Tcl_DuplicateObj(src), TCL_LEAVE_ERR_MSG);
		if (src == NULL)
			return TCL_ERROR;
	}

	/*
	fprintf(stderr, "JSON_Set, obj: \"%s\", src: \"%s\"\n",
			Tcl_GetString(obj), Tcl_GetString(src));
			*/
	target = src;

	TEST_OK(JSON_GetIntrepFromObj(interp, target, &type, &ir));
	val = get_unshared_val(ir);

	TEST_OK(Tcl_ListObjGetElements(interp, path, &pathc, &pathv));

	// Walk the path as far as it exists in src
	//fprintf(stderr, "set, initial type %s\n", type_names[type]);
	for (i=0; i<pathc; i++) {
		step = pathv[i];
		//fprintf(stderr, "looking at step %s, cx type: %s\n", Tcl_GetString(step), type_names_int[type]);

		switch (type) {
			case JSON_UNDEF: //{{{
				THROW_ERROR("Found JSON_UNDEF type jval following path");
				//}}}
			case JSON_OBJECT: //{{{
				TEST_OK(Tcl_DictObjGet(interp, val, step, &target));
				if (target == NULL) {
					//fprintf(stderr, "Path element %d: \"%s\" doesn't exist creating a new key for it and storing a null\n",
					//		i, Tcl_GetString(step));
					target = JSON_NewJvalObj(JSON_NULL, NULL);
					TEST_OK(Tcl_DictObjPut(interp, val, step, target));
					i++;
					goto followed_path;
				}
				if (Tcl_IsShared(target)) {
					//fprintf(stderr, "Path element %d: \"%s\" exists but the TclObj is shared (%d), replacing it with an unshared duplicate\n",
					//		i, Tcl_GetString(step), target->refCount);
					target = Tcl_DuplicateObj(target);
					TEST_OK(Tcl_DictObjPut(interp, val, step, target));
				}
				break;
				//}}}
			case JSON_ARRAY: //{{{
				{
					int			ac, index_str_len, ok=1;
					long		index;
					const char*	index_str;
					char*		end;
					Tcl_Obj**	av;

					TEST_OK(Tcl_ListObjGetElements(interp, val, &ac, &av));
					//fprintf(stderr, "descending into array of length %d\n", ac);

					if (Tcl_GetLongFromObj(NULL, step, &index) != TCL_OK) {
						// Index isn't an integer, check for end(+/-int)?
						index_str = Tcl_GetStringFromObj(step, &index_str_len);
						if (index_str_len < 3 || strncmp("end", index_str, 3) != 0)
							ok = 0;

						if (ok) {
							index = ac-1;
							if (index_str_len >= 4) {
								if (index_str[3] != '-' && index_str[3] != '+') {
									ok = 0;
								} else {
									// errno is magically thread-safe on POSIX
									// systems (it's thread-local)
									errno = 0;
									index += strtol(index_str+3, &end, 10);
									if (errno != 0 || *end != 0)
										ok = 0;
								}
							}
						}

						if (!ok)
							THROW_ERROR("Expected an integer index or end(+/-integer)?, got ", Tcl_GetString(step));

						//fprintf(stderr, "Resolved index of %ld from \"%s\"\n", index, index_str);
					} else {
						//fprintf(stderr, "Explicit index: %ld\n", index);
					}

					if (index < 0) {
						// Prepend element to the array
						target = JSON_NewJvalObj(JSON_NULL, NULL);
						TEST_OK(Tcl_ListObjReplace(interp, val, -1, 0, 1, &target));

						i++;
						goto followed_path;
					} else if (index >= ac) {
						int			new_i;
						for (new_i=ac; new_i<index; new_i++) {
							TEST_OK(Tcl_ListObjAppendElement(interp, val,
										JSON_NewJvalObj(JSON_NULL, NULL)));
						}
						target = JSON_NewJvalObj(JSON_NULL, NULL);
						TEST_OK(Tcl_ListObjAppendElement(interp, val, target));

						i++;
						goto followed_path;
					} else {
						target = av[index];
						if (Tcl_IsShared(target)) {
							target = Tcl_DuplicateObj(target);
							TEST_OK(Tcl_ListObjReplace(interp, val, index, 1, 1, &target));
						}
						//fprintf(stderr, "extracted index %ld: (%s)\n", index, Tcl_GetString(target));
					}
				}
				break;
				//}}}
			case JSON_STRING:
			case JSON_NUMBER:
			case JSON_BOOL:
			case JSON_NULL:
			case JSON_DYN_STRING:
			case JSON_DYN_NUMBER:
			case JSON_DYN_BOOL:
			case JSON_DYN_JSON:
			case JSON_DYN_TEMPLATE:
			case JSON_DYN_LITERAL:
				THROW_ERROR("Attempt to index into atomic type ", get_type_name(type), " at path key \"", Tcl_GetString(step), "\"");
				/*
				i++;
				goto followed_path;
				*/
			default:
				THROW_ERROR("Unhandled type: ", Tcl_GetString(Tcl_NewIntObj(type)));
		}

		TEST_OK(JSON_GetIntrepFromObj(interp, target, &type, &ir));
		val = get_unshared_val(ir);
	}

	goto set_val;

followed_path:
	TEST_OK(JSON_GetIntrepFromObj(interp, target, &type, &ir));
	val = get_unshared_val(ir);

	// target points at the (first) object to replace.  It and its internalRep
	// are unshared

	// If any path elements remain then they need to be created as object
	// keys
	//fprintf(stderr, "After walking path, %d elements remain to be created\n", pathc-i);
	for (; i<pathc; i++) {
		//fprintf(stderr, "create walk %d: %s, cx type: %s\n", i, Tcl_GetString(pathv[i]), type_names_int[type]);
		if (type != JSON_OBJECT) {
			//fprintf(stderr, "Type isn't JSON_OBJECT: %s, replacing with a JSON_OBJECT\n", type_names_int[type]);
			if (val != NULL)
				Tcl_DecrRefCount(val);
			val = Tcl_NewDictObj();
			TEST_OK(JSON_SetIntRep(target, JSON_OBJECT, val));
		}

		target = JSON_NewJvalObj(JSON_OBJECT, Tcl_NewDictObj());
		//fprintf(stderr, "Adding key \"%s\"\n", Tcl_GetString(pathv[i]));
		TEST_OK(Tcl_DictObjPut(interp, val, pathv[i], target));
		TEST_OK(JSON_GetJvalFromObj(interp, target, &type, &val));
		//fprintf(stderr, "Newly added key \"%s\" is of type %s\n", Tcl_GetString(pathv[i]), type_names_int[type]);
		// This was just created - it can't be shared
	}

set_val:
	//fprintf(stderr, "Reached end of path, calling JSON_SetIntRep for replacement value %s (%s), target is %s\n",
	//		type_names_int[newtype], Tcl_GetString(replacement), type_names_int[type]);
	rep = as_json(interp, replacement);

	TEST_OK(JSON_GetJvalFromObj(interp, rep, &newtype, &newval));
	TEST_OK(JSON_SetIntRep(target, newtype, newval));

	Tcl_InvalidateStringRep(src);

	if (interp)
		Tcl_SetObjResult(interp, src);

	return TCL_OK;
}

//}}}
int JSON_Unset(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj *path) //{{{
{
	enum json_types	type;
	int				i;
	Tcl_Obj*		val;
	Tcl_Obj*		step;
	Tcl_Obj*		src;
	Tcl_Obj*		target;
	int				pathc;
	Tcl_Obj**		pathv = NULL;

	src = Tcl_ObjGetVar2(interp, obj, NULL, TCL_LEAVE_ERR_MSG);
	if (src == NULL)
		return TCL_ERROR;

	TEST_OK(Tcl_ListObjGetElements(interp, path, &pathc, &pathv));

	if (pathc == 0) {
		Tcl_SetObjResult(interp, src);
		return TCL_OK;	// Do Nothing Gracefully
	}

	if (Tcl_IsShared(src)) {
		src = Tcl_ObjSetVar2(interp, obj, NULL, Tcl_DuplicateObj(src), TCL_LEAVE_ERR_MSG);
		if (src == NULL)
			return TCL_ERROR;
	}

	/*
	fprintf(stderr, "JSON_Set, obj: \"%s\", src: \"%s\"\n",
			Tcl_GetString(obj), Tcl_GetString(src));
			*/
	target = src;

	{
		Tcl_ObjIntRep*	ir = NULL;
		TEST_OK(JSON_GetIntrepFromObj(interp, target, &type, &ir));
		val = get_unshared_val(ir);
	}

	// Walk the path as far as it exists in src
	//fprintf(stderr, "set, initial type %s\n", type_names[type]);
	for (i=0; i<pathc-1; i++) {
		step = pathv[i];
		//fprintf(stderr, "looking at step %s, cx type: %s\n", Tcl_GetString(step), type_names_int[type]);

		switch (type) {
			case JSON_UNDEF: //{{{
				THROW_ERROR("Found JSON_UNDEF type jval following path");
				//}}}
			case JSON_OBJECT: //{{{
				TEST_OK(Tcl_DictObjGet(interp, val, step, &target));
				if (target == NULL) {
					goto bad_path;
				}
				if (Tcl_IsShared(target)) {
					//fprintf(stderr, "Path element %d: \"%s\" exists but the TclObj is shared (%d), replacing it with an unshared duplicate\n",
					//		i, Tcl_GetString(step), target->refCount);
					target = Tcl_DuplicateObj(target);
					TEST_OK(Tcl_DictObjPut(interp, val, step, target));
				}
				break;
				//}}}
			case JSON_ARRAY: //{{{
				{
					int			ac, index_str_len, ok=1;
					long		index;
					const char*	index_str;
					char*		end;
					Tcl_Obj**	av;

					TEST_OK(Tcl_ListObjGetElements(interp, val, &ac, &av));
					//fprintf(stderr, "descending into array of length %d\n", ac);

					if (Tcl_GetLongFromObj(NULL, step, &index) != TCL_OK) {
						// Index isn't an integer, check for end(+/-int)?
						index_str = Tcl_GetStringFromObj(step, &index_str_len);
						if (index_str_len < 3 || strncmp("end", index_str, 3) != 0)
							ok = 0;

						if (ok) {
							index = ac-1;
							if (index_str_len >= 4) {
								if (index_str[3] != '-' && index_str[3] != '+') {
									ok = 0;
								} else {
									// errno is magically thread-safe on POSIX
									// systems (it's thread-local)
									errno = 0;
									index += strtol(index_str+3, &end, 10);
									if (errno != 0 || *end != 0)
										ok = 0;
								}
							}
						}

						if (!ok)
							THROW_ERROR("Expected an integer index or end(+/-integer)?, got ", Tcl_GetString(step));

						//fprintf(stderr, "Resolved index of %ld from \"%s\"\n", index, index_str);
					} else {
						//fprintf(stderr, "Explicit index: %ld\n", index);
					}

					if (index < 0) {
						goto bad_path;
					} else if (index >= ac) {
						goto bad_path;
					} else {
						target = av[index];
						if (Tcl_IsShared(target)) {
							target = Tcl_DuplicateObj(target);
							TEST_OK(Tcl_ListObjReplace(interp, val, index, 1, 1, &target));
						}
						//fprintf(stderr, "extracted index %ld: (%s)\n", index, Tcl_GetString(target));
					}
				}
				break;
				//}}}
			case JSON_STRING:
			case JSON_NUMBER:
			case JSON_BOOL:
			case JSON_NULL:
			case JSON_DYN_STRING:
			case JSON_DYN_NUMBER:
			case JSON_DYN_BOOL:
			case JSON_DYN_JSON:
			case JSON_DYN_TEMPLATE:
			case JSON_DYN_LITERAL:
				THROW_ERROR("Attempt to index into atomic type ", get_type_name(type), " at path key \"", Tcl_GetString(step), "\"");
				/*
				i++;
				goto bad_path;
				*/
			default:
				THROW_ERROR("Unhandled type: ", Tcl_GetString(Tcl_NewIntObj(type)));
		}

		{
			Tcl_ObjIntRep*	ir = NULL;
			TEST_OK(JSON_GetIntrepFromObj(interp, target, &type, &ir));
			val = get_unshared_val(ir);
		}
		//fprintf(stderr, "Walked on to new type %s\n", type_names[type]);
	}

	//fprintf(stderr, "Reached end of path, calling JSON_SetIntRep for replacement value %s (%s), target is %s\n",
	//		type_names_int[newtype], Tcl_GetString(replacement), type_names_int[type]);

	step = pathv[i];	// This names the key / element to unset
	//fprintf(stderr, "To replace: path step %d: \"%s\"\n", i, Tcl_GetString(step));
	switch (type) {
		case JSON_UNDEF: //{{{
			THROW_ERROR("Found JSON_UNDEF type jval following path");
			//}}}
		case JSON_OBJECT: //{{{
			TEST_OK(Tcl_DictObjRemove(interp, val, step));
			break;
			//}}}
		case JSON_ARRAY: //{{{
			{
				int			ac, index_str_len, ok=1;
				long		index;
				const char*	index_str;
				char*		end;
				Tcl_Obj**	av;

				TEST_OK(Tcl_ListObjGetElements(interp, val, &ac, &av));
				//fprintf(stderr, "descending into array of length %d\n", ac);

				if (Tcl_GetLongFromObj(NULL, step, &index) != TCL_OK) {
					// Index isn't an integer, check for end(+/-int)?
					index_str = Tcl_GetStringFromObj(step, &index_str_len);
					if (index_str_len < 3 || strncmp("end", index_str, 3) != 0)
						ok = 0;

					if (ok) {
						index = ac-1;
						if (index_str_len >= 4) {
							if (index_str[3] != '-' && index_str[3] != '+') {
								ok = 0;
							} else {
								// errno is magically thread-safe on POSIX
								// systems (it's thread-local)
								errno = 0;
								index += strtol(index_str+3, &end, 10);
								if (errno != 0 || *end != 0)
									ok = 0;
							}
						}
					}

					if (!ok)
						THROW_ERROR("Expected an integer index or end(+/-integer)?, got ", Tcl_GetString(step));

					//fprintf(stderr, "Resolved index of %ld from \"%s\"\n", index, index_str);
				} else {
					//fprintf(stderr, "Explicit index: %ld\n", index);
				}
				//fprintf(stderr, "Removing array index %d of %d\n", index, ac);

				if (index < 0) {
					break;
				} else if (index >= ac) {
					break;
				} else {
					TEST_OK(Tcl_ListObjReplace(interp, val, index, 1, 0, NULL));
					//fprintf(stderr, "extracted index %ld: (%s)\n", index, Tcl_GetString(target));
				}
			}
			break;
			//}}}
		case JSON_STRING:
		case JSON_NUMBER:
		case JSON_BOOL:
		case JSON_NULL:
		case JSON_DYN_STRING:
		case JSON_DYN_NUMBER:
		case JSON_DYN_BOOL:
		case JSON_DYN_JSON:
		case JSON_DYN_TEMPLATE:
		case JSON_DYN_LITERAL:
			{
				Tcl_Obj* bad_path = NULL;

				Tcl_IncrRefCount(bad_path = Tcl_NewListObj(i+1, pathv));
				Tcl_SetErrorCode(interp, "RL", "JSON", "BAD_PATH", Tcl_GetString(bad_path), NULL);
				Tcl_SetObjResult(interp, Tcl_ObjPrintf("Attempt to index into atomic type %s at path \"%s\"", get_type_name(type), Tcl_GetString(bad_path)));
				Tcl_DecrRefCount(bad_path); bad_path = NULL;
				return TCL_ERROR;
			}
		default:
			THROW_ERROR("Unhandled type: ", Tcl_GetString(Tcl_NewIntObj(type)));
	}

	Tcl_InvalidateStringRep(src);

	if (interp)
		Tcl_SetObjResult(interp, src);

	return TCL_OK;

bad_path:
	{
		Tcl_Obj* bad_path = NULL;

		Tcl_IncrRefCount(bad_path = Tcl_NewListObj(i+1, pathv));
		Tcl_SetErrorCode(interp, "RL", "JSON", "BAD_PATH", Tcl_GetString(bad_path), NULL);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("Path element \"%s\" doesn't exist", Tcl_GetString(bad_path)));
		Tcl_DecrRefCount(bad_path); bad_path = NULL;
		return TCL_ERROR;
	}
}

//}}}
int JSON_Normalize(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj** normalized) //{{{
{
	int				retval = TCL_OK;
	Tcl_Obj*		json = NULL;
	enum json_types	type;

	type = JSON_GetJSONType(obj);

	if (type != JSON_UNDEF && !Tcl_HasStringRep(obj))
		return TCL_OK;		// Nothing to do - already parsed as json and have no string rep

	if (Tcl_IsShared(obj)) {
		replace_tclobj(&json, Tcl_DuplicateObj(obj));
	} else {
		replace_tclobj(&json, obj);
	}

	retval = JSON_ForceJSON(interp, json);
	Tcl_InvalidateStringRep(json);			// Defer string rep generation to our caller

	if (retval == TCL_OK)
		replace_tclobj(normalized, json);

	release_tclobj(&json);

	return retval;
}

//}}}
int JSON_Pretty(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* indent, Tcl_Obj** prettyString) //{{{
{
	int					retval = TCL_OK;
	Tcl_DString			ds;
	Tcl_Obj*			pad = NULL;
	struct interp_cx*	l = Tcl_GetAssocData(interp, "rl_json", NULL);

	if (indent == NULL)
		replace_tclobj(&indent, get_string(l, "    ", 4));

	replace_tclobj(&pad, l->tcl_empty);
	Tcl_DStringInit(&ds);
	retval = json_pretty(interp, obj, indent, pad, &ds);

	if (retval == TCL_OK)
		replace_tclobj(prettyString, Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)));

	Tcl_DStringFree(&ds);
	release_tclobj(&pad);
	release_tclobj(&indent);

	return retval;
}

//}}}
int JSON_Template(Tcl_Interp* interp, Tcl_Obj* template, Tcl_Obj* dict, Tcl_Obj** res) //{{{
{
	//struct interp_cx*	l = Tcl_GetAssocData(interp, "rl_json", NULL);
	Tcl_Obj*			actions = NULL;
	int					retcode = TCL_OK;
	Tcl_ObjIntRep*		ir;
	enum json_types		type;

	TEST_OK(JSON_GetIntrepFromObj(interp, template, &type, &ir));

	replace_tclobj(&actions, ir->twoPtrValue.ptr2);
	if (actions == NULL) {
		TEST_OK(build_template_actions(interp, template, &actions));
		replace_tclobj((Tcl_Obj**)&ir->twoPtrValue.ptr2, actions);
	}

	retcode = apply_template_actions(interp, template, actions, dict, res);
	release_tclobj(&actions);

	return retcode;
}

//}}}
int JSON_IsNULL(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path, int* isnull) //{{{
{
	int			retval = TCL_OK;
	Tcl_Obj*	jval = NULL;

	retval = JSON_Extract(interp, obj, path, &jval);

	if (retval == TCL_OK)
		*isnull = (JSON_NULL == JSON_GetJSONType(jval));

	release_tclobj(&jval);

	return retval;
}

//}}}
int JSON_Type(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path, enum json_types* type) //{{{
{
	int			retval = TCL_OK;
	Tcl_Obj*	jval = NULL;

	retval = JSON_Extract(interp, obj, path, &jval);

	if (retval == TCL_OK)
		*type = JSON_GetJSONType(jval);

	release_tclobj(&jval);

	return retval;
}

//}}}
int JSON_Length(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path, int* length) //{{{
{
	enum json_types	type;
	int				retval = TCL_OK;
	Tcl_Obj*		val = NULL;
	Tcl_Obj*		target = NULL;

	TEST_OK_LABEL(finally, retval, JSON_Extract(interp, obj, path, &target));

	TEST_OK_LABEL(finally, retval, JSON_GetJvalFromObj(interp, target, &type, &val));

	switch (type) {
		case JSON_ARRAY:  retval = Tcl_ListObjLength(interp, val, length); break;
		case JSON_OBJECT: retval = Tcl_DictObjSize(interp, val, length);   break;

		case JSON_DYN_STRING:
		case JSON_DYN_NUMBER:
		case JSON_DYN_BOOL:
		case JSON_DYN_JSON:
		case JSON_DYN_TEMPLATE:
		case JSON_DYN_LITERAL:   *length = Tcl_GetCharLength(val) + 3; break;	// dynamic types have a 3 character prefix
		case JSON_STRING:        *length = Tcl_GetCharLength(val);     break;

		default:
			Tcl_SetObjResult(interp, Tcl_ObjPrintf("Named JSON value type isn't supported: %s", get_type_name(type)));
			retval = TCL_ERROR;
	}

finally:
	release_tclobj(&target);

	return retval;
}

//}}}
int JSON_Keys(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path, Tcl_Obj** keyslist) //{{{
{
	enum json_types		type;
	int					retval = TCL_OK;
	Tcl_Obj*			val = NULL;
	Tcl_Obj*			target = NULL;

	TEST_OK_LABEL(finally, retval, JSON_Extract(interp, obj, path, &target));
	TEST_OK_LABEL(finally, retval, JSON_GetJvalFromObj(interp, target, &type, &val));

	if (type != JSON_OBJECT) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf("Named JSON value type isn't supported: %s", get_type_name(type)));
		retval = TCL_ERROR;
	} else {
		Tcl_Obj*		res = NULL;
		Tcl_Obj*		k = NULL;
		Tcl_Obj*		v = NULL;
		Tcl_DictSearch	search;
		int				done;

		replace_tclobj(&res, Tcl_NewListObj(0, NULL));

		TEST_OK_LABEL(finally, retval, Tcl_DictObjFirst(interp, val, &search, &k, &v, &done));
		for (; !done; Tcl_DictObjNext(&search, &k, &v, &done))
			TEST_OK_BREAK(retval, Tcl_ListObjAppendElement(interp, res, k));
		Tcl_DictObjDone(&search);

		if (retval == TCL_OK)
			replace_tclobj(keyslist, res);

		release_tclobj(&res);
	}

finally:
	release_tclobj(&target);

	return retval;
}

//}}}
int JSON_Decode(Tcl_Interp* interp, Tcl_Obj* bytes, Tcl_Obj* encoding, Tcl_Obj** decodedstring) //{{{
{
	struct interp_cx*	l = Tcl_GetAssocData(interp, "rl_json", NULL);
	Tcl_Obj*			ov[4];
	int					i, retval;

	ov[0] = l->apply;
	ov[1] = l->decode_bytes;
	ov[2] = bytes;
	ov[3] = encoding;

	for (i=0; i<4 && ov[i]; i++) if (ov[i]) Tcl_IncrRefCount(ov[i]);
	retval = Tcl_EvalObjv(interp, i, ov, TCL_EVAL_GLOBAL);
	for (i=0; i<4 && ov[i]; i++) release_tclobj(&ov[i]);

	if (retval == TCL_OK) {
		replace_tclobj(decodedstring, Tcl_GetObjResult(interp));
		Tcl_ResetResult(interp);
	}

	return retval;
}

//}}}
int JSON_Foreach(Tcl_Interp* interp, Tcl_Obj* iterators, int* body, enum collecting_mode collect, Tcl_Obj** res, ClientData cdata)
{
	THROW_ERROR("Not implemented yet");
}
int JSON_Valid(Tcl_Interp* interp, Tcl_Obj* json, int* valid, enum extensions extensions, struct parse_error* details)
{
	struct interp_cx*		l = NULL;
	const unsigned char*	err_at = NULL;
	const char*				errmsg = "Illegal character";
	size_t					char_adj = 0;		// Offset addjustment to account for multibyte UTF-8 sequences
	const unsigned char*	doc;
	enum json_types			type;
	const unsigned char*	p;
	const unsigned char*	e;
	const unsigned char*	val_start;
	int						len;
	struct parse_context	cx[CX_STACK_SIZE];

	if (interp)
		l = Tcl_GetAssocData(interp, "rl_json", NULL);

#if 1
	// Snoop on the intrep for clues on optimized conversions {{{
	{
		if (
			l && (
				(l->typeInt    && Tcl_FetchIntRep(json, l->typeInt)    != NULL) ||
				(l->typeDouble && Tcl_FetchIntRep(json, l->typeDouble) != NULL) ||
				(l->typeBignum && Tcl_FetchIntRep(json, l->typeBignum) != NULL)
			)
		) {
			*valid = 1;
			return TCL_OK;
		}
	}
	// Snoop on the intrep for clues on optimized conversions }}}
#endif

	cx[0].prev = NULL;
	cx[0].last = cx;
	cx[0].hold_key = NULL;
	cx[0].container = JSON_UNDEF;
	cx[0].val = NULL;
	cx[0].char_ofs = 0;
	cx[0].closed = 0;
	cx[0].l = l;
	cx[0].mode = VALIDATE;

	p = doc = (const unsigned char*)Tcl_GetStringFromObj(json, &len);
	e = p + len;

	// Skip BOM
	if (
		len >= 3 &&
		p[0] == 0xef &&
		p[1] == 0xbb &&
		p[2] == 0xbf
	) {
		p += 3;
	}	

	// Skip leading whitespace and comments
	if (skip_whitespace(&p, e, &errmsg, &err_at, &char_adj, extensions) != 0) goto whitespace_err;

	if (unlikely(p >= e)) {
		err_at = p;
		errmsg = "No JSON value found";
		goto whitespace_err;
	}

	while (p < e) {
		if (cx[0].last->container == JSON_OBJECT) { // Read the key if in object mode {{{
			const unsigned char*	key_start = p;
			size_t					key_start_char_adj = char_adj;

			if (value_type(l, doc, p, e, &char_adj, &p, &type, NULL, details) != TCL_OK) goto invalid;

			switch (type) {
				case JSON_DYN_STRING:
				case JSON_DYN_NUMBER:
				case JSON_DYN_BOOL:
				case JSON_DYN_JSON:
				case JSON_DYN_TEMPLATE:
				case JSON_DYN_LITERAL:
				case JSON_STRING:
					break;

				default:
					parse_error(details, "Object key is not a string", doc, (key_start-doc) - key_start_char_adj);
					goto invalid;
			}

			if (unlikely(skip_whitespace(&p, e, &errmsg, &err_at, &char_adj, extensions) != 0)) goto whitespace_err;

			if (unlikely(*p != ':')) {
				parse_error(details, "Expecting : after object key", doc, (p-doc) - char_adj);
				goto invalid;
			}
			p++;

			if (unlikely(skip_whitespace(&p, e, &errmsg, &err_at, &char_adj, extensions) != 0)) goto whitespace_err;
		}
		//}}}

		val_start = p;
		if (value_type(l, doc, p, e, &char_adj, &p, &type, NULL, details) != TCL_OK) goto invalid;

		switch (type) {
			case JSON_OBJECT:
				push_parse_context(cx, JSON_OBJECT, (val_start - doc) - char_adj);
				if (unlikely(skip_whitespace(&p, e, &errmsg, &err_at, &char_adj, extensions) != 0)) goto whitespace_err;

				if (*p == '}') {
					pop_parse_context(cx);
					p++;
					goto after_value;
				}
				continue;

			case JSON_ARRAY:
				push_parse_context(cx, JSON_ARRAY, (val_start - doc) - char_adj);
				if (unlikely(skip_whitespace(&p, e, &errmsg, &err_at, &char_adj, extensions) != 0)) goto whitespace_err;

				if (*p == ']') {
					pop_parse_context(cx);
					p++;
					goto after_value;
				}
				continue;

			case JSON_DYN_STRING:
			case JSON_DYN_NUMBER:
			case JSON_DYN_BOOL:
			case JSON_DYN_JSON:
			case JSON_DYN_TEMPLATE:
			case JSON_DYN_LITERAL:
			case JSON_STRING:
			case JSON_BOOL:
			case JSON_NULL:
			case JSON_NUMBER:
				if (unlikely(cx->last->container != JSON_OBJECT && cx->last->container != JSON_ARRAY))
					cx->last->container = type;	// Record our type (at the document top-level)
				break;

			default:
				Tcl_SetObjResult(interp, Tcl_ObjPrintf("Unexpected json value type: %d", type));
				goto err;
		}

after_value:	// Yeah, goto.  But the alternative abusing loops was worse
		if (unlikely(skip_whitespace(&p, e, &errmsg, &err_at, &char_adj, extensions) != 0)) goto whitespace_err;
		if (p >= e) break;

		if (unlikely(cx[0].last->closed)) {
			parse_error(details, "Trailing garbage after value", doc, (p-doc) - char_adj);
			goto invalid;
		}

		switch (cx[0].last->container) { // Handle eof and end-of-context or comma for array and object {{{
			case JSON_OBJECT:
				if (*p == '}') {
					pop_parse_context(cx);
					p++;
					goto after_value;
				} else if (unlikely(*p != ',')) {
					parse_error(details, "Expecting } or ,", doc, (p-doc) - char_adj);
					goto invalid;
				}

				p++;
				break;

			case JSON_ARRAY:
				if (*p == ']') {
					pop_parse_context(cx);
					p++;
					goto after_value;
				} else if (unlikely(*p != ',')) {
					parse_error(details, "Expecting ] or ,", doc, (p-doc) - char_adj);
					goto invalid;
				}

				p++;
				break;

			default:
				if (unlikely(p < e)) {
					parse_error(details, "Trailing garbage after value", doc, (p - doc) - char_adj);
					goto invalid;
				}
		}

		if (unlikely(skip_whitespace(&p, e, &errmsg, &err_at, &char_adj, extensions) != 0)) goto whitespace_err;
		//}}}
	}

	if (unlikely(cx != cx[0].last || !cx[0].closed)) { // Unterminated object or array context {{{
		switch (cx[0].last->container) {
			case JSON_OBJECT:
				parse_error(details, "Unterminated object", doc, cx[0].last->char_ofs);
				goto invalid;

			case JSON_ARRAY:
				parse_error(details, "Unterminated array", doc, cx[0].last->char_ofs);
				goto invalid;

			default:	// Suppress compiler warning
				break;
		}
	}
	//}}}

	*valid = 1;
	return TCL_OK;

whitespace_err:
	parse_error(details, errmsg, doc, (err_at - doc) - char_adj);

invalid:
	free_cx(cx);

	// This was a parse error, which is a successful outcome for us
	*valid = 0;
	return TCL_OK;

err:
	free_cx(cx);
	return TCL_ERROR;
}

/* Local Variables: */
/* tab-width: 4 */
/* c-basic-offset: 4 */
/* End: */
// vim: foldmethod=marker foldmarker={{{,}}} ts=4 shiftwidth=4

#if DEDUP

#if FFS == ffsll
#define _GNU_SOURCE		// For glibc extension ffsll
#endif

#include "rl_jsonInt.h"

static int first_free(FREEMAP_TYPE* freemap) //{{{
{
	int	i=0, bit, res;
	FFS_TMP_STORAGE;

	while ((bit = FFS(freemap[i])) == 0) i++;
	res = i * (sizeof(FREEMAP_TYPE)*8) + (bit-1);
	return res;
}

//}}}
static void mark_used(FREEMAP_TYPE* freemap, int idx) //{{{
{
	int	i = idx / (sizeof(FREEMAP_TYPE)*8);
	int bit = idx - (i * (sizeof(FREEMAP_TYPE)*8));
	freemap[i] &= ~(1LL << bit);
}

//}}}
static void mark_free(FREEMAP_TYPE* freemap, int idx) //{{{
{
	int	i = idx / (sizeof(FREEMAP_TYPE)*8);
	int bit = idx - (i * (sizeof(FREEMAP_TYPE)*8));
	freemap[i] |= 1LL << bit;
}

//}}}
void free_cache(struct interp_cx* l) //{{{
{
	Tcl_HashEntry*		he;
	Tcl_HashSearch		search;
	struct kc_entry*	e;

	he = Tcl_FirstHashEntry(&l->kc, &search);
	while (he) {
		ptrdiff_t	idx = (ptrdiff_t)Tcl_GetHashValue(he);

		//if (idx >= KC_ENTRIES) Tcl_Panic("age_cache: idx (%ld) is out of bounds, KC_ENTRIES: %d", idx, KC_ENTRIES);
		//printf("age_cache: kc_count: %d", l->kc_count);
		e = &l->kc_entries[idx];

		Tcl_DeleteHashEntry(he);
		Tcl_DecrRefCount(e->val);
		Tcl_DecrRefCount(e->val);	// Two references - one for the cache table and one on loan to callers' interim processing
		mark_free(l->freemap, idx);
		e->val = NULL;
		he = Tcl_NextHashEntry(&search);
	}
	l->kc_count = 0;
}

//}}}
static void age_cache(struct interp_cx* l) //{{{
{
	Tcl_HashEntry*		he;
	Tcl_HashSearch		search;
	struct kc_entry*	e;

	he = Tcl_FirstHashEntry(&l->kc, &search);
	while (he) {
		ptrdiff_t	idx = (ptrdiff_t)Tcl_GetHashValue(he);

		//if (idx >= KC_ENTRIES) Tcl_Panic("age_cache: idx (%ld) is out of bounds, KC_ENTRIES: %d", idx, KC_ENTRIES);
		//printf("age_cache: kc_count: %d", l->kc_count);
		e = &l->kc_entries[idx];

		if (e->hits < 1) {
			Tcl_DeleteHashEntry(he);
			Tcl_DecrRefCount(e->val);
			Tcl_DecrRefCount(e->val);	// Two references - one for the cache table and one on loan to callers' interim processing
			mark_free(l->freemap, idx);
			e->val = NULL;
		} else {
			e->hits >>= 1;
		}
		he = Tcl_NextHashEntry(&search);
	}
	l->kc_count = 0;
}

//}}}
Tcl_Obj* new_stringobj_dedup(struct interp_cx* l, const char* bytes, int length) //{{{
{
	char				buf[STRING_DEDUP_MAX + 1];
	const char			*keyname;
	int					is_new;
	struct kc_entry*	kce;
	Tcl_Obj*			out;
	Tcl_HashEntry*		entry = NULL;

	if (l == NULL)
		return Tcl_NewStringObj(bytes, length);

	if (length == 0) {
		return l->tcl_empty;
	} else if (length < 0) {
		length = strlen(bytes);
	}

	if (length > STRING_DEDUP_MAX)
		return Tcl_NewStringObj(bytes, length);

	if (likely(bytes[length] == 0)) {
		keyname = bytes;
	} else {
		memcpy(buf, bytes, length);
		buf[length] = 0;
		keyname = buf;
	}
	entry = Tcl_CreateHashEntry(&l->kc, keyname, &is_new);

	if (is_new) {
		ptrdiff_t	idx = first_free(l->freemap);

		if (unlikely(idx >= KC_ENTRIES)) {
			// Cache overflow
			Tcl_DeleteHashEntry(entry);
			age_cache(l);
			return Tcl_NewStringObj(bytes, length);
		}

		kce = &l->kc_entries[idx];
		kce->hits = 0;
		out = kce->val = Tcl_NewStringObj(bytes, length);
		Tcl_IncrRefCount(out);	// Two references - one for the cache table and one on loan to callers' interim processing.
		Tcl_IncrRefCount(out);	// Without this, values not referenced elsewhere could reach callers with refCount 1, allowing
								// the value to be mutated in place and corrupt the state of the cache (hash key not matching obj value)

		mark_used(l->freemap, idx);

		Tcl_SetHashValue(entry, (void*)idx);
		l->kc_count++;

		if (unlikely(l->kc_count > (int)(KC_ENTRIES/2.5))) {
			kce->hits++; // Prevent the just-created entry from being pruned
			age_cache(l);
		}
	} else {
		ptrdiff_t	idx = (ptrdiff_t)Tcl_GetHashValue(entry);

		kce = &l->kc_entries[idx];
		out = kce->val;
		if (kce->hits < 255) kce->hits++;
	}

	return out;
}

//}}}

#endif

#ifndef _DEDUP_H
#define _DEDUP_H

#if DEDUP
#define STRING_DEDUP_MAX	16

void free_cache(struct interp_cx* l);
Tcl_Obj* new_stringobj_dedup(struct interp_cx* l, const char* bytes, int length);
#	define get_string(l, bytes, length)	new_stringobj_dedup(l, bytes, length)
#else
#	define free_cache(l)	// nop
#	define get_string(l, bytes, length) Tcl_NewStringObj(bytes, length)
#endif


#endif

#include "rl_jsonInt.h"
#include "parser.h"

static void free_internal_rep(Tcl_Obj* obj, Tcl_ObjType* objtype);
static void dup_internal_rep(Tcl_Obj* src, Tcl_Obj* dest, Tcl_ObjType* objtype);
static void update_string_rep(Tcl_Obj* obj, Tcl_ObjType* objtype);
static int set_from_any(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_ObjType** objtype, enum json_types* type);

extern Tcl_ObjType json_object;
extern Tcl_ObjType json_array;
extern Tcl_ObjType json_string;
extern Tcl_ObjType json_number;
extern Tcl_ObjType json_bool;
extern Tcl_ObjType json_null;
extern Tcl_ObjType json_dyn_string;
extern Tcl_ObjType json_dyn_number;
extern Tcl_ObjType json_dyn_bool;
extern Tcl_ObjType json_dyn_json;
extern Tcl_ObjType json_dyn_template;
extern Tcl_ObjType json_dyn_literal;

static void free_internal_rep_object(Tcl_Obj* obj)                { free_internal_rep(obj, &json_object);      }
static void dup_internal_rep_object(Tcl_Obj* src, Tcl_Obj* dest)  { dup_internal_rep(src, dest, &json_object); }
static void update_string_rep_object(Tcl_Obj* obj)                { update_string_rep(obj, &json_object);      }

static void free_internal_rep_array(Tcl_Obj* obj)                { free_internal_rep(obj, &json_array);      }
static void dup_internal_rep_array(Tcl_Obj* src, Tcl_Obj* dest)  { dup_internal_rep(src, dest, &json_array); }
static void update_string_rep_array(Tcl_Obj* obj)                { update_string_rep(obj, &json_array);      }

static void free_internal_rep_string(Tcl_Obj* obj)                { free_internal_rep(obj, &json_string);      }
static void dup_internal_rep_string(Tcl_Obj* src, Tcl_Obj* dest)  { dup_internal_rep(src, dest, &json_string); }
static void update_string_rep_string(Tcl_Obj* obj);

static void free_internal_rep_number(Tcl_Obj* obj)                { free_internal_rep(obj, &json_number);      }
static void dup_internal_rep_number(Tcl_Obj* src, Tcl_Obj* dest)  { dup_internal_rep(src, dest, &json_number); }
static void update_string_rep_number(Tcl_Obj* obj);

static void free_internal_rep_bool(Tcl_Obj* obj)                { free_internal_rep(obj, &json_bool);      }
static void dup_internal_rep_bool(Tcl_Obj* src, Tcl_Obj* dest)  { dup_internal_rep(src, dest, &json_bool); }
static void update_string_rep_bool(Tcl_Obj* obj);

static void free_internal_rep_null(Tcl_Obj* obj)                { free_internal_rep(obj, &json_null);      }
static void dup_internal_rep_null(Tcl_Obj* src, Tcl_Obj* dest)  { dup_internal_rep(src, dest, &json_null); }
static void update_string_rep_null(Tcl_Obj* obj);

static void free_internal_rep_dyn_string(Tcl_Obj* obj)                { free_internal_rep(obj, &json_dyn_string);      }
static void dup_internal_rep_dyn_string(Tcl_Obj* src, Tcl_Obj* dest)  { dup_internal_rep(src, dest, &json_dyn_string); }
static void update_string_rep_dyn_string(Tcl_Obj* obj)                { update_string_rep(obj, &json_dyn_string);      }

static void free_internal_rep_dyn_number(Tcl_Obj* obj)                { free_internal_rep(obj, &json_dyn_number);      }
static void dup_internal_rep_dyn_number(Tcl_Obj* src, Tcl_Obj* dest)  { dup_internal_rep(src, dest, &json_dyn_number); }
static void update_string_rep_dyn_number(Tcl_Obj* obj)                { update_string_rep(obj, &json_dyn_number);      }

static void free_internal_rep_dyn_bool(Tcl_Obj* obj)                { free_internal_rep(obj, &json_dyn_bool);      }
static void dup_internal_rep_dyn_bool(Tcl_Obj* src, Tcl_Obj* dest)  { dup_internal_rep(src, dest, &json_dyn_bool); }
static void update_string_rep_dyn_bool(Tcl_Obj* obj)                { update_string_rep(obj, &json_dyn_bool);      }

static void free_internal_rep_dyn_json(Tcl_Obj* obj)                { free_internal_rep(obj, &json_dyn_json);      }
static void dup_internal_rep_dyn_json(Tcl_Obj* src, Tcl_Obj* dest)  { dup_internal_rep(src, dest, &json_dyn_json); }
static void update_string_rep_dyn_json(Tcl_Obj* obj)                { update_string_rep(obj, &json_dyn_json);      }

static void free_internal_rep_dyn_template(Tcl_Obj* obj)                { free_internal_rep(obj, &json_dyn_template);      }
static void dup_internal_rep_dyn_template(Tcl_Obj* src, Tcl_Obj* dest)  { dup_internal_rep(src, dest, &json_dyn_template); }
static void update_string_rep_dyn_template(Tcl_Obj* obj)                { update_string_rep(obj, &json_dyn_template);      }

static void free_internal_rep_dyn_literal(Tcl_Obj* obj)                { free_internal_rep(obj, &json_dyn_literal);      }
static void dup_internal_rep_dyn_literal(Tcl_Obj* src, Tcl_Obj* dest)  { dup_internal_rep(src, dest, &json_dyn_literal); }
static void update_string_rep_dyn_literal(Tcl_Obj* obj);

Tcl_ObjType json_object = {
	"JSON_object",
	free_internal_rep_object,
	dup_internal_rep_object,
	update_string_rep_object,
	NULL
};
Tcl_ObjType json_array = {
	"JSON_array",
	free_internal_rep_array,
	dup_internal_rep_array,
	update_string_rep_array,
	NULL
};
Tcl_ObjType json_string = {
	"JSON_string",
	free_internal_rep_string,
	dup_internal_rep_string,
	update_string_rep_string,
	NULL
};
Tcl_ObjType json_number = {
	"JSON_number",
	free_internal_rep_number,
	dup_internal_rep_number,
	update_string_rep_number,
	NULL
};
Tcl_ObjType json_bool = {
	"JSON_bool",
	free_internal_rep_bool,
	dup_internal_rep_bool,
	update_string_rep_bool,
	NULL
};
Tcl_ObjType json_null = {
	"JSON_null",
	free_internal_rep_null,
	dup_internal_rep_null,
	update_string_rep_null,
	NULL
};
Tcl_ObjType json_dyn_string = {
	"JSON_dyn_string",
	free_internal_rep_dyn_string,
	dup_internal_rep_dyn_string,
	update_string_rep_dyn_string,
	NULL
};
Tcl_ObjType json_dyn_number = {
	"JSON_dyn_number",
	free_internal_rep_dyn_number,
	dup_internal_rep_dyn_number,
	update_string_rep_dyn_number,
	NULL
};
Tcl_ObjType json_dyn_bool = {
	"JSON_dyn_bool",
	free_internal_rep_dyn_bool,
	dup_internal_rep_dyn_bool,
	update_string_rep_dyn_bool,
	NULL
};
Tcl_ObjType json_dyn_json = {
	"JSON_dyn_json",
	free_internal_rep_dyn_json,
	dup_internal_rep_dyn_json,
	update_string_rep_dyn_json,
	NULL
};
Tcl_ObjType json_dyn_template = {
	"JSON_dyn_template",
	free_internal_rep_dyn_template,
	dup_internal_rep_dyn_template,
	update_string_rep_dyn_template,
	NULL
};
Tcl_ObjType json_dyn_literal = {
	"JSON_dyn_literal",
	free_internal_rep_dyn_literal,
	dup_internal_rep_dyn_literal,
	update_string_rep_dyn_literal,
	NULL
};

Tcl_ObjType* g_objtype_for_type[JSON_TYPE_MAX];


int JSON_IsJSON(Tcl_Obj* obj, enum json_types* type, Tcl_ObjIntRep** ir) //{{{
{
	enum json_types		t;
	Tcl_ObjIntRep*		_ir = NULL;

	for (t=JSON_OBJECT; t<JSON_TYPE_MAX && _ir==NULL; t++)
		_ir = Tcl_FetchIntRep(obj, g_objtype_for_type[t]);
	t--;

	if (_ir == NULL)
		return 0;

	*ir = _ir;
	*type = t;
	return 1;
}

//}}}
int JSON_GetIntrepFromObj(Tcl_Interp* interp, Tcl_Obj* obj, enum json_types* type, Tcl_ObjIntRep** ir) //{{{
{
	enum json_types		t;
	Tcl_ObjIntRep*		_ir = NULL;
	Tcl_ObjType*		objtype = NULL;

	if (!JSON_IsJSON(obj, &t, &_ir)) {
		TEST_OK(set_from_any(interp, obj, &objtype, &t));
		_ir = Tcl_FetchIntRep(obj, objtype);
		if (_ir == NULL) Tcl_Panic("Could not retrieve the intrep we just created");
	}

	*type = t;
	*ir = _ir;

	return TCL_OK;
}

//}}}
int JSON_GetJvalFromObj(Tcl_Interp* interp, Tcl_Obj* obj, enum json_types* type, Tcl_Obj** val) //{{{
{
	Tcl_ObjIntRep*		ir = NULL;

	TEST_OK(JSON_GetIntrepFromObj(interp, obj, type, &ir));

	*val = ir->twoPtrValue.ptr1;

	return TCL_OK;
}

//}}}
int JSON_SetIntRep(Tcl_Obj* target, enum json_types type, Tcl_Obj* replacement) //{{{
{
	Tcl_ObjIntRep		intrep;
	Tcl_ObjType*		objtype = NULL;

	if (Tcl_IsShared(target))
		Tcl_Panic("Called JSON_SetIntRep on a shared object");

	objtype = g_objtype_for_type[type];

	Tcl_FreeIntRep(target);

	intrep.twoPtrValue.ptr1 = replacement;		// ptr1 is the Tcl_Obj holding the Tcl structure for this value
	if (replacement) Tcl_IncrRefCount((Tcl_Obj*)intrep.twoPtrValue.ptr1);

	intrep.twoPtrValue.ptr2 = NULL;				// ptr2 holds the template actions, if any have been generated for this value

	Tcl_StoreIntRep(target, objtype, &intrep);

	Tcl_InvalidateStringRep(target);

	return TCL_OK;
}

//}}}
#ifdef TCL_MEM_DEBUG
Tcl_Obj* JSON_DbNewJvalObj(enum json_types type, Tcl_Obj* val, const char* file, int line)
#else
Tcl_Obj* JSON_NewJvalObj(enum json_types type, Tcl_Obj* val)
#endif
{ //{{{
#ifdef TCL_MEM_DEBUG
	Tcl_Obj*	res = Tcl_DbNewObj(file, line);
#else
	Tcl_Obj*	res = Tcl_NewObj();
#endif

	/*
	switch (type) {
		case JSON_OBJECT:
		case JSON_ARRAY:
		case JSON_STRING:
		case JSON_NUMBER:
		case JSON_BOOL:
		case JSON_NULL:

		case JSON_DYN_STRING:
		case JSON_DYN_NUMBER:
		case JSON_DYN_BOOL:
		case JSON_DYN_JSON:
		case JSON_DYN_TEMPLATE:
		case JSON_DYN_LITERAL:
			break;

		default:
			Tcl_Panic("JSON_NewJvalObj, unhandled type: %d", type);
	}
	*/

	if (JSON_SetIntRep(res, type, val) != TCL_OK)
		Tcl_Panic("Couldn't set JSON intrep");

	return res;
}

//}}}

static void free_internal_rep(Tcl_Obj* obj, Tcl_ObjType* objtype) //{{{
{
	Tcl_ObjIntRep*		ir = NULL;

	ir = Tcl_FetchIntRep(obj, objtype);
	if (ir != NULL) {
		release_tclobj((Tcl_Obj**)&ir->twoPtrValue.ptr1);
		release_tclobj((Tcl_Obj**)&ir->twoPtrValue.ptr2);

#if 0
		//Tcl_Obj* ir_obj = ir->twoPtrValue.ptr1;
		Tcl_Obj* actions = ir->twoPtrValue.ptr2;
		if (ir->twoPtrValue.ptr1) {
			/*
			fprintf(stderr, "%s Releasing ptr1 %p, refcount %d, which is %s\n",
					objtype->name, ir->twoPtrValue.ptr1, ir_obj == NULL ? -42 : ir_obj->refCount,
					ir_obj->typePtr ? ir_obj->typePtr->name : "pure string"
				   );
				   */
			Tcl_DecrRefCount((Tcl_Obj*)ir->twoPtrValue.ptr1); ir->twoPtrValue.ptr1 = NULL;}
		if (ir->twoPtrValue.ptr2 && actions->refCount > 0) {
			/*
			fprintf(stderr, "%s Releasing ptr2 %p, refcount %d, which is %s\n",
					objtype->name, ir->twoPtrValue.ptr2, actions == NULL ? -42 : actions->refCount,
					actions->typePtr ? actions->typePtr->name : "pure string"
				   );
				   */
			Tcl_DecrRefCount((Tcl_Obj*)ir->twoPtrValue.ptr2); ir->twoPtrValue.ptr2 = NULL;}
#endif
	}
}

//}}}
static void dup_internal_rep(Tcl_Obj* src, Tcl_Obj* dest, Tcl_ObjType* objtype) //{{{
{
	Tcl_ObjIntRep*		srcir = NULL;
	Tcl_ObjIntRep		destir;

	srcir = Tcl_FetchIntRep(src, objtype);
	if (srcir == NULL)
		Tcl_Panic("dup_internal_rep asked to duplicate for type, but that type wasn't available on the src object");

	if (src == srcir->twoPtrValue.ptr1) {
		int			len;
		const char*	str = Tcl_GetStringFromObj((Tcl_Obj*)srcir->twoPtrValue.ptr1, &len);
		// Don't know how this happens yet, but it's bad news - we get into an endless recursion of duplicateobj calls until the stack blows up

		// Panic and go via the string rep
		Tcl_IncrRefCount((Tcl_Obj*)(destir.twoPtrValue.ptr1 = Tcl_NewStringObj(str, len)));
	} else {
		destir.twoPtrValue.ptr1 = srcir->twoPtrValue.ptr1;
	}

	destir.twoPtrValue.ptr2 = srcir->twoPtrValue.ptr2;
	if (destir.twoPtrValue.ptr1) Tcl_IncrRefCount((Tcl_Obj*)destir.twoPtrValue.ptr1);
	if (destir.twoPtrValue.ptr2) Tcl_IncrRefCount((Tcl_Obj*)destir.twoPtrValue.ptr2);

	Tcl_StoreIntRep(dest, objtype, &destir);
}

//}}}
static void update_string_rep(Tcl_Obj* obj, Tcl_ObjType* objtype) //{{{
{
	Tcl_ObjIntRep*				ir = Tcl_FetchIntRep(obj, objtype);
	struct serialize_context	scx;
	Tcl_DString					ds;

	if (ir == NULL)
		Tcl_Panic("dup_internal_rep asked to duplicate for type, but that type wasn't available on the src object");

	Tcl_DStringInit(&ds);

	scx.ds = &ds;
	scx.serialize_mode = SERIALIZE_NORMAL;
	scx.fromdict = NULL;
	scx.l = NULL;
	scx.allow_null = 1;

	serialize(NULL, &scx, obj);

	obj->length = Tcl_DStringLength(&ds);
	obj->bytes = ckalloc(obj->length + 1);
	memcpy(obj->bytes, Tcl_DStringValue(&ds), obj->length);
	obj->bytes[obj->length] = 0;

	Tcl_DStringFree(&ds);	scx.ds = NULL;
}

//}}}
static void update_string_rep_string(Tcl_Obj* obj) //{{{
{
	update_string_rep(obj, &json_string);
	/*
	Tcl_ObjIntRep*	ir = Tcl_FetchIntRep(obj, &json_string);
	const char*		str;
	int				len;

	str = Tcl_GetStringFromObj((Tcl_Obj*)ir->twoPtrValue.ptr1, &len);
	obj->bytes = ckalloc(len+3);
	obj->bytes[0] = '"';
	memcpy(obj->bytes+1, str, len);
	obj->bytes[len+1] = '"';
	obj->bytes[len+2] = 0;
	obj->length = len+2;
	*/
}

//}}}
static void update_string_rep_number(Tcl_Obj* obj) //{{{
{
	Tcl_ObjIntRep*	ir = Tcl_FetchIntRep(obj, &json_number);
	const char*		str;
	int				len;

	if (ir->twoPtrValue.ptr1 == obj)
		Tcl_Panic("Turtles all the way down!");

	str = Tcl_GetStringFromObj((Tcl_Obj*)ir->twoPtrValue.ptr1, &len);
	obj->bytes = ckalloc(len+1);
	memcpy(obj->bytes, str, len+1);
	obj->length = len;
}

//}}}
static void update_string_rep_bool(Tcl_Obj* obj) //{{{
{
	Tcl_ObjIntRep*	ir = Tcl_FetchIntRep(obj, &json_bool);
	int				boolval;

	if (Tcl_GetBooleanFromObj(NULL, (Tcl_Obj*)ir->twoPtrValue.ptr1, &boolval) != TCL_OK)
		Tcl_Panic("json_bool's intrep tclobj is not a boolean");

	if (boolval) {
		obj->bytes = ckalloc(5);
		memcpy(obj->bytes, "true", 5);
		obj->length = 4;
	} else {
		obj->bytes = ckalloc(6);
		memcpy(obj->bytes, "false", 6);
		obj->length = 5;
	}
}

//}}}
static void update_string_rep_null(Tcl_Obj* obj) //{{{
{
	obj->bytes = ckalloc(5);
	memcpy(obj->bytes, "null", 5);
	obj->length = 4;
}

//}}}
static void update_string_rep_dyn_literal(Tcl_Obj* obj) //{{{
{
	update_string_rep(obj, &json_dyn_literal);
	/*
	Tcl_ObjIntRep*	ir = Tcl_FetchIntRep(obj, &json_dyn_literal);
	const char*		str;
	int				len;

	str = Tcl_GetStringFromObj((Tcl_Obj*)ir->twoPtrValue.ptr1, &len);
	obj->bytes = ckalloc(len+6);
	obj->bytes[0] = '"';
	obj->bytes[1] = '~';
	obj->bytes[2] = 'L';
	obj->bytes[3] = ':';
	memcpy(obj->bytes+4, str, len);
	obj->bytes[len+4] = '"';
	obj->bytes[len+5] = 0;
	obj->length = len+5;
	*/
}

//}}}
static int set_from_any(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_ObjType** objtype, enum json_types* out_type) //{{{
{
	struct interp_cx*		l = NULL;
	const unsigned char*	err_at = NULL;
	const char*				errmsg = "Illegal character";
	size_t					char_adj = 0;		// Offset addjustment to account for multibyte UTF-8 sequences
	const unsigned char*	doc;
	enum json_types			type;
	Tcl_Obj*				val = NULL;
	const unsigned char*	p;
	const unsigned char*	e;
	const unsigned char*	val_start;
	int						len;
	struct parse_context	cx[CX_STACK_SIZE];
	enum extensions			extensions = EXT_COMMENTS;
	struct parse_error		details = {};

	if (interp)
		l = Tcl_GetAssocData(interp, "rl_json", NULL);

#if 1
	// Snoop on the intrep for clues on optimized conversions {{{
	{
		if (
			l && (
				(l->typeInt    && Tcl_FetchIntRep(obj, l->typeInt)    != NULL) ||
				(l->typeDouble && Tcl_FetchIntRep(obj, l->typeDouble) != NULL) ||
				(l->typeBignum && Tcl_FetchIntRep(obj, l->typeBignum) != NULL)
			)
		) {
			Tcl_ObjIntRep			ir = {.twoPtrValue = {}};

			// Must dup because obj will soon be us, creating a circular ref
			replace_tclobj((Tcl_Obj**)&ir.twoPtrValue.ptr1, Tcl_DuplicateObj(obj));
			release_tclobj((Tcl_Obj**)&ir.twoPtrValue.ptr2);

			*out_type = JSON_NUMBER;
			*objtype = g_objtype_for_type[JSON_NUMBER];

			Tcl_StoreIntRep(obj, *objtype, &ir);
			return TCL_OK;
		}
	}
	// Snoop on the intrep for clues on optimized conversions }}}
#endif

	cx[0].prev = NULL;
	cx[0].last = cx;
	cx[0].hold_key = NULL;
	cx[0].container = JSON_UNDEF;
	cx[0].val = NULL;
	cx[0].char_ofs = 0;
	cx[0].closed = 0;
	cx[0].l = l;
	cx[0].mode = PARSE;

	p = doc = (const unsigned char*)Tcl_GetStringFromObj(obj, &len);
	e = p + len;

	// Skip BOM
	if (
		len >= 3 &&
		p[0] == 0xef &&
		p[1] == 0xbb &&
		p[2] == 0xbf
	) {
		p += 3;
	}	

	// Skip leading whitespace and comments
	if (skip_whitespace(&p, e, &errmsg, &err_at, &char_adj, extensions) != 0) goto whitespace_err;

	while (p < e) {
		if (cx[0].last->container == JSON_OBJECT) { // Read the key if in object mode {{{
			const unsigned char*	key_start = p;
			size_t					key_start_char_adj = char_adj;

			if (value_type(l, doc, p, e, &char_adj, &p, &type, &val, &details) != TCL_OK) goto err;

			switch (type) {
				case JSON_DYN_STRING:
				case JSON_DYN_NUMBER:
				case JSON_DYN_BOOL:
				case JSON_DYN_JSON:
				case JSON_DYN_TEMPLATE:
				case JSON_DYN_LITERAL:
					/* Add back the template format prefix, since we can't store the type
					 * in the dict key.  The template generation code reparses it later.
					 */
					{
						Tcl_Obj*	new = Tcl_ObjPrintf("~%c:%s", key_start[2], Tcl_GetString(val));
						replace_tclobj(&val, new);
						// Can do this because val's ref is on loan from new_stringobj_dedup
						//val = Tcl_ObjPrintf("~%c:%s", key_start[2], Tcl_GetString(val));
					}
					// Falls through
				case JSON_STRING:
					replace_tclobj(&cx[0].last->hold_key, val);
					break;

				default:
					parse_error(&details, "Object key is not a string", doc, (key_start-doc) - key_start_char_adj);
					goto err;
			}

			if (unlikely(skip_whitespace(&p, e, &errmsg, &err_at, &char_adj, extensions) != 0)) goto whitespace_err;

			if (unlikely(*p != ':')) {
				parse_error(&details, "Expecting : after object key", doc, (p-doc) - char_adj);
				goto err;
			}
			p++;

			if (unlikely(skip_whitespace(&p, e, &errmsg, &err_at, &char_adj, extensions) != 0)) goto whitespace_err;
		}
		//}}}

		val_start = p;
		if (value_type(l, doc, p, e, &char_adj, &p, &type, &val, &details) != TCL_OK) goto err;

		switch (type) {
			case JSON_OBJECT:
				push_parse_context(cx, JSON_OBJECT, (val_start - doc) - char_adj);
				if (unlikely(skip_whitespace(&p, e, &errmsg, &err_at, &char_adj, extensions) != 0)) goto whitespace_err;

				if (*p == '}') {
					pop_parse_context(cx);
					p++;
					goto after_value;
				}
				continue;

			case JSON_ARRAY:
				push_parse_context(cx, JSON_ARRAY, (val_start - doc) - char_adj);
				if (unlikely(skip_whitespace(&p, e, &errmsg, &err_at, &char_adj, extensions) != 0)) goto whitespace_err;

				if (*p == ']') {
					pop_parse_context(cx);
					p++;
					goto after_value;
				}
				continue;

			case JSON_DYN_STRING:
			case JSON_DYN_NUMBER:
			case JSON_DYN_BOOL:
			case JSON_DYN_JSON:
			case JSON_DYN_TEMPLATE:
			case JSON_DYN_LITERAL:
			case JSON_STRING:
			case JSON_BOOL:
			case JSON_NULL:
			case JSON_NUMBER:
				append_to_cx(cx->last, JSON_NewJvalObj(type, val));
				if (unlikely(cx->last->container != JSON_OBJECT && cx->last->container != JSON_ARRAY))
					cx->last->container = type;	// Record our type (at the document top-level)
				break;

			default:
				Tcl_SetObjResult(interp, Tcl_ObjPrintf("Unexpected json value type: %d", type));
				goto err;
		}

after_value:	// Yeah, goto.  But the alternative abusing loops was worse
		if (unlikely(skip_whitespace(&p, e, &errmsg, &err_at, &char_adj, extensions) != 0)) goto whitespace_err;
		if (p >= e) break;

		if (unlikely(cx[0].last->closed)) {
			parse_error(&details, "Trailing garbage after value", doc, (p-doc) - char_adj);
			goto err;
		}

		switch (cx[0].last->container) { // Handle eof and end-of-context or comma for array and object {{{
			case JSON_OBJECT:
				if (*p == '}') {
					pop_parse_context(cx);
					p++;
					goto after_value;
				} else if (unlikely(*p != ',')) {
					parse_error(&details, "Expecting } or ,", doc, (p-doc) - char_adj);
					goto err;
				}

				p++;
				break;

			case JSON_ARRAY:
				if (*p == ']') {
					pop_parse_context(cx);
					p++;
					goto after_value;
				} else if (unlikely(*p != ',')) {
					parse_error(&details, "Expecting ] or ,", doc, (p-doc) - char_adj);
					goto err;
				}

				p++;
				break;

			default:
				if (unlikely(p < e)) {
					parse_error(&details, "Trailing garbage after value", doc, (p - doc) - char_adj);
					goto err;
				}
		}

		if (unlikely(skip_whitespace(&p, e, &errmsg, &err_at, &char_adj, extensions) != 0)) goto whitespace_err;
		//}}}
	}

	if (unlikely(cx != cx[0].last || !cx[0].closed)) { // Unterminated object or array context {{{
		switch (cx[0].last->container) {
			case JSON_OBJECT:
				parse_error(&details, "Unterminated object", doc, cx[0].last->char_ofs);
				goto err;

			case JSON_ARRAY:
				parse_error(&details, "Unterminated array", doc, cx[0].last->char_ofs);
				goto err;

			default:	// Suppress compiler warning
				break;
		}
	}
	//}}}

	if (unlikely(cx[0].val == NULL)) {
		err_at = doc;
		errmsg = "No JSON value found";
		goto whitespace_err;
	}

	//Tcl_FreeIntRep(obj);

	{
		Tcl_ObjType*	top_objtype = g_objtype_for_type[cx[0].container];
		Tcl_ObjIntRep*	top_ir = Tcl_FetchIntRep(cx[0].val, top_objtype);
		Tcl_ObjIntRep	ir = {.twoPtrValue = {}};

		if (unlikely(top_ir == NULL))
			Tcl_Panic("Can't get intrep for the top container");

		// We're transferring the ref from cx[0].val to our intrep
		replace_tclobj((Tcl_Obj**)&ir.twoPtrValue.ptr1, top_ir->twoPtrValue.ptr1);
		release_tclobj((Tcl_Obj**)&ir.twoPtrValue.ptr2);
		release_tclobj(&cx[0].val);

		Tcl_StoreIntRep(obj, top_objtype, &ir);
		*objtype = top_objtype;
		*out_type = cx[0].container;
	}

	release_tclobj(&val);
	return TCL_OK;

whitespace_err:
	parse_error(&details, errmsg, doc, (err_at - doc) - char_adj);

err:
	if (details.errmsg)
		throw_parse_error(interp, &details);

	release_tclobj(&val);
	free_cx(cx);
	return TCL_ERROR;
}

//}}}
int type_is_dynamic(const enum json_types type) //{{{
{
	switch (type) {
		case JSON_DYN_STRING:
		case JSON_DYN_NUMBER:
		case JSON_DYN_BOOL:
		case JSON_DYN_JSON:
		case JSON_DYN_TEMPLATE:
		case JSON_DYN_LITERAL:
			return 1;
		default:
			return 0;
	}
}

//}}}
Tcl_Obj* get_unshared_val(Tcl_ObjIntRep* ir) //{{{
{
	if (ir->twoPtrValue.ptr1 != NULL && Tcl_IsShared((Tcl_Obj*)ir->twoPtrValue.ptr1)) {
		replace_tclobj((Tcl_Obj**)&ir->twoPtrValue.ptr1, Tcl_DuplicateObj(ir->twoPtrValue.ptr1));
	}

	if (ir->twoPtrValue.ptr2) {
		// The caller wants val unshared, which implies that they intend to
		// change it, which would invalidate our cached template actions, so
		// release those if we have them
		release_tclobj((Tcl_Obj**)&ir->twoPtrValue.ptr2);
	}

	return ir->twoPtrValue.ptr1;
}

//}}}

int init_types(Tcl_Interp* interp) //{{{
{
	// We don't define set_from_any callbacks for our types, so they must not be Tcl_RegisterObjType'ed

	g_objtype_for_type[JSON_UNDEF]			= NULL;
	g_objtype_for_type[JSON_OBJECT]			= &json_object;
	g_objtype_for_type[JSON_ARRAY]			= &json_array;
	g_objtype_for_type[JSON_STRING]			= &json_string;
	g_objtype_for_type[JSON_NUMBER]			= &json_number;
	g_objtype_for_type[JSON_BOOL]			= &json_bool;
	g_objtype_for_type[JSON_NULL]			= &json_null;
	g_objtype_for_type[JSON_DYN_STRING]		= &json_dyn_string;
	g_objtype_for_type[JSON_DYN_NUMBER]		= &json_dyn_number;
	g_objtype_for_type[JSON_DYN_BOOL]		= &json_dyn_bool;
	g_objtype_for_type[JSON_DYN_JSON]		= &json_dyn_json;
	g_objtype_for_type[JSON_DYN_TEMPLATE]	= &json_dyn_template;
	g_objtype_for_type[JSON_DYN_LITERAL]	= &json_dyn_literal;

	return TCL_OK;
}

//}}}

/* Local Variables: */
/* tab-width: 4 */
/* c-basic-offset: 4 */
/* End: */
// vim: foldmethod=marker foldmarker={{{,}}} ts=4 shiftwidth=4

#include "rl_jsonInt.h"
#include "parser.h"

enum char_advance_status {
	CHAR_ADVANCE_OK,
	CHAR_ADVANCE_UNESCAPED_NULL
};

void parse_error(struct parse_error* details, const char* errmsg, const unsigned char* doc, size_t char_ofs) //{{{
{
	if (details == NULL) return;

	details->errmsg = errmsg;
	details->doc = (const char*)doc;
	details->char_ofs = char_ofs;
}

//}}}
void throw_parse_error(Tcl_Interp* interp, struct parse_error* details) //{{{
{
	char		char_ofs_buf[20];		// 20 bytes allows for 19 bytes of decimal max 64 bit size_t, plus null terminator

	snprintf(char_ofs_buf, 20, "%ld", (long) details->char_ofs);

	Tcl_SetObjResult(interp, Tcl_ObjPrintf("Error parsing JSON value: %s at offset %ld", details->errmsg, (long) details->char_ofs));
	Tcl_SetErrorCode(interp, "RL", "JSON", "PARSE", details->errmsg, details->doc, char_ofs_buf, NULL);
}

//}}}
struct parse_context* push_parse_context(struct parse_context* cx, const enum json_types container, const size_t char_ofs) //{{{
{
	struct parse_context*	last = cx->last;
	struct parse_context*	new;


	if (last->container == JSON_UNDEF) {
		new = last;
	} else if (likely((ptrdiff_t)last >= (ptrdiff_t)cx && (ptrdiff_t)last < (ptrdiff_t)(cx + CX_STACK_SIZE - 1))) {
		// Space remains on the cx array stack
		new = cx->last+1;
	} else {
		new = (struct parse_context*)malloc(sizeof(*new));
	}




	new->prev = last;
	if (last->mode == VALIDATE) {
		new->val = NULL;
	} else {
		Tcl_IncrRefCount(
			new->val = JSON_NewJvalObj(container, container == JSON_OBJECT  ?
				(cx->l ? cx->l->tcl_empty_dict : Tcl_NewDictObj())  :
				(cx->l ? cx->l->tcl_empty_list : Tcl_NewListObj(0, NULL))
		));
	}
	new->hold_key = NULL;
	new->char_ofs = char_ofs;
	new->container = container;
	new->closed = 0;
	new->objtype = g_objtype_for_type[container];
	new->l = last->l;
	new->mode = last->mode;

	cx->last = new;

	return new;
}

//}}}
struct parse_context* pop_parse_context(struct parse_context* cx) //{{{
{
	struct parse_context*	last = cx->last;

	cx->last->closed = 1;

	if (unlikely((ptrdiff_t)cx == (ptrdiff_t)last)) {
		return cx->last;
	}

	if (likely(last->val != NULL)) {
		if (last->prev->val && Tcl_IsShared(last->prev->val))
			replace_tclobj(&last->prev->val, Tcl_DuplicateObj(last->prev->val));

		append_to_cx(last->prev, last->val);

		release_tclobj(&last->val);
	}

	if (likely((ptrdiff_t)last >= (ptrdiff_t)cx && (ptrdiff_t)last < (ptrdiff_t)(cx + CX_STACK_SIZE))) {
		// last is on the cx array stack
		cx->last--;
	} else {
		if (last->prev) {

//}}}
void free_cx(struct parse_context* cx) //{{{
{
	struct parse_context*	tail = cx->last;

	while (1) {
		release_tclobj(&tail->hold_key);

		release_tclobj(&tail->val);


		if (tail == cx) break;




		tail = pop_parse_context(cx);


	}
}

//}}}
static int is_whitespace(const unsigned char c) //{{{
{
	switch (c) {
		case 0x20:
		case 0x09:
		case 0x0A:
		case 0x0D:
			return 1;

		default:
			return 0;
	}
}

//}}}
static enum char_advance_status char_advance(const unsigned char** p, size_t* char_adj) //{{{
{
	// TODO: use Tcl_UtfNext instead?
	// This relies on some properties from the utf-8 returned by Tcl_GetString:
	//	- no invalid encodings (partial utf-8 sequences, etc)
	//	- not truncated in the middle of a char
	const unsigned char	first = **p;
	unsigned int		eat;

	(*p)++;
	if (unlikely(first >= 0xC0)) {
		// Advance to next UTF-8 character
		// TODO: detect invalid sequences?
		if (first == 0xC0 && **p == 0x80) {
			(*p)--;
			// Have to check for this here - other unescaped control chars are handled by the < 0x1F
			// test, but 0x00 is transformed to 0xC0 0x80 by Tcl (MUTF-8 rather than UTF-8)
			return CHAR_ADVANCE_UNESCAPED_NULL;
		}
		if (first < 0xe0 /* 0b11100000 */) {
			eat = 1;
#if TCL_UTF_MAX == 3
		} else {
			eat = 2;
#else
		} else if (first < 0xf0 /* 0b11110000 */) {
			eat = 2;
		} else if (first < 0xf8 /* 0b11111000 */) {
			eat = 3;
		} else if (first < 0xfc /* 0b11111100 */) {
			eat = 4;
		} else {
			eat = 5;
#endif
		}
		*p += eat;
		*char_adj += eat;
	}

	return CHAR_ADVANCE_OK;
}

//}}}
int skip_whitespace(const unsigned char** s, const unsigned char* e, const char** errmsg, const unsigned char** err_at, size_t* char_adj, enum extensions extensions) //{{{
{
	const unsigned char*		p = *s;
	const unsigned char*		start;
	size_t						start_char_adj;
	enum char_advance_status	status = CHAR_ADVANCE_OK;

consume_space_or_comment:
	while (is_whitespace(*p)) p++;

	if (unlikely((extensions & EXT_COMMENTS) && *p == '/')) {
		start = p;
		start_char_adj = *char_adj;
		p++;
		if (*p == '/') {
			p++;

			while (likely(p < e && (*p > 0x1f || *p == 0x09) && status == CHAR_ADVANCE_OK))
				status = char_advance(&p, char_adj);
		} else if (*p == '*') {
			p++;

			while (likely(p < e-2 && *p != '*')) {
				if (unlikely(*p <= 0x1f && !is_whitespace(*p))) goto err_illegal_char;
				status = char_advance(&p, char_adj);
				if (unlikely(status != CHAR_ADVANCE_OK)) goto err_illegal_char;
			}

			if (unlikely(*p++ != '*' || *p++ != '/')) goto err_unterminated;
		} else {
			goto err_illegal_char;
		}

	*err_at = p;
	*errmsg = "Illegal character";
	*s = p;
	return 1;
}

//}}}
int is_template(const char* s, int len) //{{{
{
	if (
		len >= 3 &&
		s[0] == '~' &&
		s[2] == ':'
	) {
		switch (s[1]) {
			case 'S':
			case 'N':
			case 'B':
			case 'J':
			case 'T':
			case 'L':
				return 1;
		}
	}

	return 0;
}

//}}}
int value_type(struct interp_cx* l, const unsigned char* doc, const unsigned char* p, const unsigned char* e, size_t* char_adj, const unsigned char** next, enum json_types *type, Tcl_Obj** val, struct parse_error* details) //{{{
{
	const unsigned char*	err_at = NULL;
	const char*				errmsg = NULL;
	Tcl_Obj*				out = NULL;

	if (val)
		release_tclobj(val);

	if (unlikely(p >= e)) goto err;

	switch (*p) {
		case '"':
			p++;	// Advance past the " to the first byte of the string
			{

				const unsigned char*		chunk;
				size_t						len;
				char						mapped;
				enum json_types				stype = JSON_STRING;
				enum char_advance_status	status = CHAR_ADVANCE_OK;

				// Peek ahead to detect template subst markers.






				TEMPLATE_TYPE(p, e-p, stype);






				while (1) {
					chunk = p;

					// These tests are where the majority of the parsing time is spent
					while (likely(p < e && *p != '"' && *p != '\\' && *p > 0x1f && status == CHAR_ADVANCE_OK))
						status = char_advance(&p, char_adj);

					if (unlikely(p >= e)) goto err;

					len = p-chunk;

					if (likely(out == NULL)) {
						replace_tclobj(&out, get_string(l, (const char*)chunk, len));
					} else if (len > 0) {
						if (unlikely(Tcl_IsShared(out)))
							replace_tclobj(&out, Tcl_DuplicateObj(out));

						Tcl_AppendToObj(out, (const char*)chunk, len);
					}

					if (likely(*p == '"')) {
						p++;	// Point at the first byte after the string
						break;
					}

					if (unlikely(*p != '\\')) goto err;

					p++;	// Advance to the backquoted byte

					if (unlikely(Tcl_IsShared(out)))
						replace_tclobj(&out, Tcl_DuplicateObj(out));

					switch (*p) {	// p could point at the NULL terminator at this point
						case '\\':
						case '"':
						case '/':		// RFC4627 allows this for some reason
							mapped = *p;
							goto append_mapped;

						default:
							goto err;
					}
					p++;	// Advance to the first byte after the backquoted sequence
				}

				*type = stype;
				if (val)
					replace_tclobj(val, out);
			}
			break;

		case '{':
			*type = JSON_OBJECT;
			p++;
			break;

		case '[':
			*type = JSON_ARRAY;
			p++;
			break;

		case 't':
			if (unlikely(e-p < 4 || *(uint32_t*)p != *(uint32_t*)"true")) goto err;		// Evil endian-compensated trick

			*type = JSON_BOOL;
			if (val)
				replace_tclobj(val, l ? l->tcl_true : Tcl_NewBooleanObj(1));
			p += 4;
			break;

		case 'f':
			if (unlikely(e-p < 5 || *(uint32_t*)(p+1) != *(uint32_t*)"alse")) goto err;	// Evil endian-compensated trick

			*type = JSON_BOOL;
			if (val)
				replace_tclobj(val, l ? l->tcl_false : Tcl_NewBooleanObj(0));
			p += 5;
			break;

		case 'n':
			if (unlikely(e-p < 4 || *(uint32_t*)p != *(uint32_t*)"null")) goto err;		// Evil endian-compensated trick

			*type = JSON_NULL;
			if (val)
				replace_tclobj(val, l ? l->tcl_empty : Tcl_NewStringObj("", 0));
			p += 4;
			break;

		default:

			{
				const unsigned char*	start = p;
				const unsigned char*	t;

				if (*p == '-') p++;

				if (unlikely(
						*p == '0' && (
							// Only 3 characters can legally follow a leading '0' according to the spec:
							// . - fraction, e or E - exponent
							(p[1] >= '0' && p[1] <= '9')		// Octal, hex, or decimal with leading 0
						)
				)) {
					// Indexing one beyond p is safe - all the strings we
					// receive are guaranteed to be null terminated by Tcl, and
					// *p here is '0'
					err_at = p;
					errmsg = "Leading 0 not allowed for numbers";
					goto err;
				}

				t = p;
				while (*p >= '0' && *p <= '9') p++;
				if (unlikely(p == t)) goto err;	// No integer part after the decimal point

				if (*p == '.') {	// p could point at the NULL terminator at this point
					p++;

					if (*p == '+' || *p == '-') p++;
					t = p;
					while (*p >= '0' && *p <= '9') p++;
					if (unlikely(p == t)) goto err;	// No integer part after the exponent symbol
				}

				*type = JSON_NUMBER;
				if (val)
					replace_tclobj(val, get_string(l, (const char*)start, p-start));
			}
	}

	release_tclobj(&out);
	*next = p;
	return TCL_OK;

err:
	release_tclobj(&out);

	if (err_at == NULL)
		err_at = p;

	if (errmsg == NULL)
		errmsg = (err_at == e) ? "Document truncated" : "Illegal character";

	parse_error(details, errmsg, doc, (err_at - doc) - *char_adj);

	return TCL_ERROR;
}

//}}}

// vim: foldmethod=marker foldmarker={{{,}}} ts=4 shiftwidth=4

#ifndef _JSON_PARSER_H
#define _JSON_PARSER_H









#include "rl_jsonInt.h"










int skip_whitespace(const unsigned char** s, const unsigned char* e, const char** errmsg, const unsigned char** err_at, size_t* char_adj, enum extensions extensions);

int value_type(struct interp_cx* l, const unsigned char* doc, const unsigned char* p, const unsigned char* e, size_t* char_adj, const unsigned char** next, enum json_types *type, Tcl_Obj** val, struct parse_error* details);




void parse_error(struct parse_error* details, const char* errmsg, const unsigned char* doc, size_t char_ofs);











































void throw_parse_error(Tcl_Interp* interp, struct parse_error* details);
struct parse_context* push_parse_context(struct parse_context* cx, const enum json_types container, const size_t char_ofs);
struct parse_context* pop_parse_context(struct parse_context* cx);
void free_cx(struct parse_context* cx);


int test_parse(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]);

#endif

#include "rl_jsonInt.h"

#ifndef ENSEMBLE
#define ENSEMBLE	0
#endif

#if defined(_WIN32)
#define snprintf _snprintf
#endif






#ifdef WIN32
#define _DLLEXPORT extern DLLEXPORT
#else
#define _DLLEXPORT
#endif









static const char* dyn_prefix[] = {
	NULL,	// JSON_UNDEF
	NULL,	// JSON_OBJECT
	NULL,	// JSON_ARRAY
	NULL,	// JSON_STRING
	NULL,	// JSON_NUMBER
	NULL,	// JSON_BOOL

	"string",		// JSON_DYN_STRING
	"string",		// JSON_DYN_NUMBER
	"string",		// JSON_DYN_BOOL
	"string",		// JSON_DYN_JSON
	"string",		// JSON_DYN_TEMPLATE
	"string"		// JSON_DYN_LITERAL
};

const char* type_names_int[] = {	// Must match the order of the json_types enum
	"JSON_UNDEF",
	"JSON_OBJECT",
	"JSON_ARRAY",
	"JSON_STRING",
	"JSON_NUMBER",
	"JSON_BOOL",
	"JSON_NULL",

	"JSON_DYN_STRING",
	"JSON_DYN_NUMBER",
	"JSON_DYN_BOOL",
	"JSON_DYN_JSON",
	"JSON_DYN_TEMPLATE",
	"JSON_DYN_LITERAL"
};

static const char* action_opcode_str[] = { // Must match the order of the action_opcode enum
	"NOP",
	"ALLOCATE",

	"FETCH_VALUE",
	"DECLARE_LITERAL",
	"STORE_STRING",
	"STORE_NUMBER",
	"STORE_BOOLEAN",
	"STORE_JSON",

	"STORE_TEMPLATE",

	"PUSH_TARGET",
	"POP_TARGET",
	"REPLACE_VAL",
	"REPLACE_ARR",
	"REPLACE_ATOM",
	"REPLACE_KEY",

	(char*)NULL
};





static const char *extension_str[] = {


	"",




	"comments",







	(char*)NULL



};









static int new_json_value_from_list(Tcl_Interp* interp, int objc, Tcl_Obj *const objv[], Tcl_Obj** res);
static int NRforeach_next_loop_bottom(ClientData cdata[], Tcl_Interp* interp, int retcode);


static int json_pretty_dbg(Tcl_Interp* interp, Tcl_Obj* json, Tcl_Obj* indent, Tcl_Obj* pad, Tcl_DString* ds);






const char* get_dyn_prefix(enum json_types type) //{{{
{



	if (!type_is_dynamic(type)) {
		return "";




	} else {










		return dyn_prefix[type];
	}
}













































//}}}



const char* get_type_name(enum json_types type) //{{{




{

	return type_names[type];


}



//}}}








Tcl_Obj* as_json(Tcl_Interp* interp, Tcl_Obj* from) //{{{


{






	Tcl_ObjIntRep*	ir = NULL;






	enum json_types	type;




	if (JSON_GetIntrepFromObj(interp, from, &type, &ir) == TCL_OK) {






		// Already a JSON value, use it directly





		return from;

	} else {

		// Anything else, use it as a JSON string




		return JSON_NewJvalObj(JSON_STRING, from);		// EIAS, so we can use whatever $from is as the intrep for a JSON_STRING value











	}

}












//}}}



































int force_json_number(Tcl_Interp* interp, struct interp_cx* l, Tcl_Obj* obj, Tcl_Obj** forced) //{{{
{
	int	res = TCL_OK;

	// TODO: investigate a direct bytecode version?

	/*
display *obj
	 */
	if (l) {
		// Attempt to snoop on the intrep to verify that it is one of the numeric types
		if (
			obj->typePtr && (
				(l->typeInt    && Tcl_FetchIntRep(obj, l->typeInt) != NULL) ||
				(l->typeDouble && Tcl_FetchIntRep(obj, l->typeDouble) != NULL) ||
				(l->typeBignum && Tcl_FetchIntRep(obj, l->typeBignum) != NULL)
		   )
		) {
			// It's a known number type, we can safely use it directly
			//fprintf(stderr, "force_json_number fastpath, verified obj to be a number type\n");
			if (forced == NULL) return TCL_OK;

			if (Tcl_HasStringRep(obj)) { // Has a string rep already, make sure it's not hex or octal, and not padded with whitespace
				const char* s;
				int			len, start=0;

				s = Tcl_GetStringFromObj(obj, &len);
				if (len >= 1 && s[0] == '-')
					start++;

				if (unlikely(
					(len+start >= 1 && (
						(s[start] == '0' && len+start >= 2 && s[start+1] != '.') || // Octal or hex, or double with leading zero not immediately followed by .)
						s[start] == ' '  ||
						s[start] == '\n' ||
						s[start] == '\t' ||
						s[start] == '\v' ||
						s[start] == '\r' ||
						s[start] == '\f'
					)) ||
					(len-start >= 2 && (
						s[len-1] == ' '  ||
						s[len-1] == '\n' ||
						s[len-1] == '\t' ||
						s[len-1] == '\v' ||
						s[len-1] == '\r' ||
						s[len-1] == '\f'
					))
				)) {
					// The existing string rep is one of the cases
					// (octal / hex / whitespace padded) that is not a
					// valid JSON number.  Duplicate the obj and
					// invalidate the string rep
					Tcl_IncrRefCount(*forced = Tcl_DuplicateObj(obj));
					Tcl_InvalidateStringRep(*forced);
				} else {
					// String rep is safe as a JSON number
					Tcl_IncrRefCount(*forced = obj);
					//fprintf(stderr, "force_json_number obj stringrep is safe json number: (%s), intrep: (%s)\n", Tcl_GetString(obj), obj->typePtr->name);
				}
			} else {
				// Pure number - no string rep
				Tcl_IncrRefCount(*forced = obj);
			}

			return TCL_OK;
		} else {
			// Could be a string that is a valid number representation, or
			// something that will convert to a valid number.  Add 0 to it to
			// check (all valid numbers succeed at this, and are unchanged by
			// it).  Use the cached objs
			Tcl_IncrRefCount(l->force_num_cmd[2] = obj);
			res = Tcl_EvalObjv(interp, 3, l->force_num_cmd, TCL_EVAL_DIRECT);
			Tcl_DecrRefCount(l->force_num_cmd[2]);
			l->force_num_cmd[2] = NULL;
		}

	} else {
		Tcl_Obj*	cmd;

		cmd = Tcl_NewListObj(0, NULL);
		TEST_OK(Tcl_ListObjAppendElement(interp, cmd, Tcl_NewStringObj("::tcl::mathop::+", -1)));
		TEST_OK(Tcl_ListObjAppendElement(interp, cmd, Tcl_NewIntObj(0)));
		TEST_OK(Tcl_ListObjAppendElement(interp, cmd, obj));

		Tcl_IncrRefCount(cmd);
		res = Tcl_EvalObjEx(interp, cmd, TCL_EVAL_DIRECT);
		Tcl_DecrRefCount(cmd);
	}

	if (res == TCL_OK) {
		if (forced != NULL)
			Tcl_IncrRefCount(*forced = Tcl_GetObjResult(interp));

		Tcl_ResetResult(interp);
	}

	return res;
}

//}}}
static void append_json_string(const struct serialize_context* scx, Tcl_Obj* obj) //{{{
{

				case 0x8:	Tcl_DStringAppend(ds, "\\b", 2); break;
				case 0xC:	Tcl_DStringAppend(ds, "\\f", 2); break;
				case 0xA:	Tcl_DStringAppend(ds, "\\n", 2); break;
				case 0xD:	Tcl_DStringAppend(ds, "\\r", 2); break;
				case 0x9:	Tcl_DStringAppend(ds, "\\t", 2); break;

				default:









					snprintf(ustr, 7, "\\u%04X", c);
					Tcl_DStringAppend(ds, ustr, 6);
					break;
			}
			p += adv;
			chunk = p;
		} else {

			//}}}
		case JSON_OBJECT: //{{{
			{
				int				done, first=1;
				Tcl_DictSearch	search;
				Tcl_Obj*		k;
				Tcl_Obj*		v;
				enum json_types	v_type = JSON_UNDEF;
				Tcl_Obj*		iv = NULL;

				TEST_OK(Tcl_DictObjFirst(interp, val, &search, &k, &v, &done));

				Tcl_DStringAppend(ds, "{", 1);
				for (; !done; Tcl_DictObjNext(&search, &k, &v, &done)) {
					if (!first) {
						Tcl_DStringAppend(ds, ",", 1);
					} else {
						first = 0;
					}

					// Have to do the template subst here rather than at
					// parse time since the dict keys would be broken otherwise
					if (scx->serialize_mode == SERIALIZE_TEMPLATE) {
						int			len, stype;
						const char*	s;

						s = Tcl_GetStringFromObj(k, &len);

						if (
								len >= 3 &&
								s[0] == '~' &&
								s[2] == ':'
						) {
							switch (s[1]) {
								case 'S': stype = JSON_DYN_STRING; break;
								case 'L': stype = JSON_DYN_LITERAL; break;

								case 'N':
								case 'B':
								case 'J':
								case 'T':
									Tcl_SetObjResult(interp, Tcl_ObjPrintf("Only strings allowed as object keys, got %s", s));

									res = TCL_ERROR;
									goto done;

								default:  stype = JSON_UNDEF; break;
							}

							if (stype != JSON_UNDEF) {
								int hold = scx->allow_null;
								scx->allow_null = 0;
								if (serialize_json_val(interp, scx, stype, Tcl_GetRange(k, 3, len-1)) != TCL_OK) {
									scx->allow_null = hold;
									res = TCL_ERROR;
									break;
								}
								scx->allow_null = hold;
							} else {
								append_json_string(scx, k);
							}
						} else {
							append_json_string(scx, k);
						}
					} else {

				Tcl_DStringAppend(ds, "}", 1);
				Tcl_DictObjDone(&search);
			}
			break;
			//}}}
		case JSON_ARRAY: //{{{
			{
				int				i, oc, first=1;
				Tcl_Obj**		ov;
				Tcl_Obj*		iv = NULL;
				enum json_types	v_type = JSON_UNDEF;

				TEST_OK(Tcl_ListObjGetElements(interp, val, &oc, &ov));

				Tcl_DStringAppend(ds, "[", 1);
				for (i=0; i<oc; i++) {
					if (!first) {
						Tcl_DStringAppend(ds, ",", 1);
					} else {
						first = 0;
					}
					JSON_GetJvalFromObj(interp, ov[i], &v_type, &iv);
					TEST_OK(serialize_json_val(interp, scx, v_type, iv));
				}
				Tcl_DStringAppend(ds, "]", 1);
			}
			break;
			//}}}
		case JSON_NUMBER: //{{{

			if (scx->serialize_mode == SERIALIZE_NORMAL) {
				Tcl_Obj*	tmp = Tcl_ObjPrintf("%s%s", dyn_prefix[type], Tcl_GetString(val));

				Tcl_IncrRefCount(tmp);
				append_json_string(scx, tmp);
				Tcl_DecrRefCount(tmp);
			} else {
				Tcl_Obj*		subst_val = NULL;
				enum json_types	subst_type;
				int				reset_mode = 0;

				if (type == JSON_DYN_LITERAL) {
					append_json_string(scx, val);
					break;
				}

				if (scx->fromdict != NULL) {
					TEST_OK(Tcl_DictObjGet(interp, scx->fromdict, val, &subst_val));
				} else {
					subst_val = Tcl_ObjGetVar2(interp, val, NULL, 0);
				}

				if (subst_val == NULL) {

					subst_type = JSON_NULL;
				} else {
					subst_type = from_dyn[type];
					Tcl_IncrRefCount(subst_val);
				}

				if (subst_type == JSON_DYN_JSON) {
					if (subst_val != NULL) Tcl_DecrRefCount(subst_val);
					res = JSON_GetJvalFromObj(interp, subst_val, &subst_type, &subst_val);
					if (subst_val != NULL) Tcl_IncrRefCount(subst_val);
					scx->serialize_mode = SERIALIZE_NORMAL;
					reset_mode = 1;
				} else if (subst_type == JSON_DYN_TEMPLATE) {
					if (subst_val != NULL) Tcl_DecrRefCount(subst_val);
					res = JSON_GetJvalFromObj(interp, subst_val, &subst_type, &subst_val);
					if (subst_val != NULL) Tcl_IncrRefCount(subst_val);
				} else if (subst_type == JSON_NUMBER) {
					Tcl_Obj*	forced = NULL;

					if ((res = force_json_number(interp, scx->l, subst_val, &forced)) == TCL_OK)
						replace_tclobj(&subst_val, forced);

					release_tclobj(&forced);
					if (res != TCL_OK) {
						Tcl_SetObjResult(interp, Tcl_ObjPrintf("Error substituting value from \"%s\" into template, not a number: \"%s\"", Tcl_GetString(val), Tcl_GetString(subst_val)));
						return TCL_ERROR;
					}
				}



				if (subst_type == JSON_NULL && !scx->allow_null)

					THROW_ERROR("Only strings allowed as object keys");


				if (res == TCL_OK)
					res = serialize_json_val(interp, scx, subst_type, subst_val);

				if (subst_val != NULL)
					Tcl_DecrRefCount(subst_val);

				if (reset_mode)

	return res;
}

//}}}

void append_to_cx(struct parse_context* cx, Tcl_Obj* val) //{{{
{
	Tcl_ObjIntRep*	ir = NULL;
	Tcl_Obj*		ir_val = NULL;

	/*
	fprintf(stderr, "append_to_cx, storing %s: \"%s\"\n",
			type_names[val->internalRep.ptrAndLongRep.value],
			val->internalRep.ptrAndLongRep.ptr == NULL ? "NULL" :
			Tcl_GetString((Tcl_Obj*)val->internalRep.ptrAndLongRep.ptr));
	*/
	if (cx->mode == VALIDATE) return;

	switch (cx->container) {
		case JSON_OBJECT:
			//fprintf(stderr, "append_to_cx, cx->hold_key->refCount: %d (%s)\n", cx->hold_key->refCount, Tcl_GetString(cx->hold_key));
			ir = Tcl_FetchIntRep(cx->val, cx->objtype);
			if (ir == NULL) Tcl_Panic("Can't get intrep for container");
			ir_val = get_unshared_val(ir);
			Tcl_DictObjPut(NULL, ir_val, cx->hold_key, val);
			if (ir->twoPtrValue.ptr2) {release_tclobj((Tcl_Obj**)&ir->twoPtrValue.ptr2);}
			Tcl_InvalidateStringRep(cx->val);

			release_tclobj(&cx->hold_key);
			break;

		case JSON_ARRAY:
			ir = Tcl_FetchIntRep(cx->val, cx->objtype);
			if (ir == NULL) Tcl_Panic("Can't get intrep for container");
			ir_val = get_unshared_val(ir);
			//fprintf(stderr, "append_to_cx, appending to list: (%s)\n", Tcl_GetString(val));
			Tcl_ListObjAppendElement(NULL, ir_val, val);
			if (ir->twoPtrValue.ptr2) {release_tclobj((Tcl_Obj**)&ir->twoPtrValue.ptr2);}
			Tcl_InvalidateStringRep(cx->val);
			break;

		default:
			replace_tclobj(&cx->val, val);

	}
}

//}}}

int serialize(Tcl_Interp* interp, struct serialize_context* scx, Tcl_Obj* obj) //{{{
{
	enum json_types	type = JSON_UNDEF;
	int				res;
	Tcl_Obj*		val = NULL;

	TEST_OK(JSON_GetJvalFromObj(interp, obj, &type, &val));

	res = serialize_json_val(interp, scx, type, val);

	// The result of the serialization is left in scx->ds.  Once the caller
	// is done with this value it must be freed with Tcl_DStringFree()
	return res;
}









































































































































































































































































//}}}

static int get_modifier(Tcl_Interp* interp, Tcl_Obj* modobj, enum modifiers* modifier) //{{{
{
	// This must be kept in sync with the modifiers enum
	static CONST char *modstrings[] = {
		"",

	TEST_OK(Tcl_GetIndexFromObj(interp, modobj, modstrings, "modifier", TCL_EXACT, &index));
	*modifier = index;

	return TCL_OK;
}

//}}}








int resolve_path(Tcl_Interp* interp, Tcl_Obj* src, Tcl_Obj *const pathv[], int pathc, Tcl_Obj** target, const int exists, const int modifiers) //{{{

{










































































































































































































	int					i, modstrlen;




	enum json_types		type;














	struct interp_cx*	l = Tcl_GetAssocData(interp, "rl_json", NULL);

































































































































































































































	const char*			modstr;
	enum modifiers		modifier;
	Tcl_Obj*			val;
	Tcl_Obj*			step;

#define EXISTS(bool) \
	if (exists) { \
		Tcl_SetObjResult(interp, (bool) ? l->tcl_true : l->tcl_false); \
		return TCL_OK; \
	}

	replace_tclobj(target, src);

	if (unlikely(JSON_GetJvalFromObj(interp, *target, &type, &val) != TCL_OK)) {
		if (exists) {
			Tcl_ResetResult(interp);
			// [dict exists] considers any test to be false when applied to an invalid value, so we do the same
			EXISTS(0);

		}
		return TCL_ERROR;
	}

	//fprintf(stderr, "resolve_path, initial type %s\n", type_names[type]);
	for (i=0; i<pathc; i++) {
		step = pathv[i];

							switch (type) {
								case JSON_ARRAY:
									{
										int			ac;
										Tcl_Obj**	av;
										TEST_OK(Tcl_ListObjGetElements(interp, val, &ac, &av));
										EXISTS(1);
										replace_tclobj(target, Tcl_NewIntObj(ac));
									}
									break;
								case JSON_STRING:
									EXISTS(1);
									replace_tclobj(target, Tcl_NewIntObj(Tcl_GetCharLength(val)));
									break;
								case JSON_DYN_STRING:
								case JSON_DYN_NUMBER:
								case JSON_DYN_BOOL:
								case JSON_DYN_JSON:
								case JSON_DYN_TEMPLATE:
								case JSON_DYN_LITERAL:
									EXISTS(1);
									replace_tclobj(target, Tcl_NewIntObj(Tcl_GetCharLength(val) + 3));
									break;
								default:
									EXISTS(0);
									THROW_ERROR(Tcl_GetString(step), " modifier is not supported for type ", type_names[type]);
							}
							break;
							//}}}
						case MODIFIER_SIZE: //{{{
							if (type != JSON_OBJECT) {
								EXISTS(0);
								THROW_ERROR(Tcl_GetString(step), " modifier is not supported for type ", type_names[type]);
							}
							{
								int	size;
								TEST_OK(Tcl_DictObjSize(interp, val, &size));
								EXISTS(1);
								replace_tclobj(target, Tcl_NewIntObj(size));
							}
							break;
							//}}}
						case MODIFIER_TYPE: //{{{
							EXISTS(1);
							replace_tclobj(target, l->type[type]);
							break;
							//}}}
						case MODIFIER_KEYS: //{{{
							if (type != JSON_OBJECT) {
								EXISTS(0);
								THROW_ERROR(Tcl_GetString(step), " modifier is not supported for type ", type_names[type]);
							}
							{
								Tcl_DictSearch	search;
								Tcl_Obj*		k;
								Tcl_Obj*		v;
								int				done, retval=TCL_OK;
								Tcl_Obj*		res = NULL;

								TEST_OK(Tcl_DictObjFirst(interp, val, &search, &k, &v, &done));
								if (exists) {
									Tcl_DictObjDone(&search);
									EXISTS(1);
								}

								replace_tclobj(&res, Tcl_NewListObj(0, NULL));

								for (; !done; Tcl_DictObjNext(&search, &k, &v, &done))
									TEST_OK_BREAK(retval, Tcl_ListObjAppendElement(interp, res, k));




								Tcl_DictObjDone(&search);
								if (retval == TCL_OK) replace_tclobj(target, res);
								release_tclobj(&res);
								if (retval != TCL_OK) return retval;
							}
							break;
							//}}}
						default:
							THROW_ERROR("Unhandled modifier type: ", Tcl_GetString(Tcl_NewIntObj(modifier)));
					}
					//fprintf(stderr, "Handled modifier, skipping descent check\n");
					break;
				}
			}
		}
		switch (type) {
			case JSON_UNDEF: //{{{
				THROW_ERROR("Found JSON_UNDEF type jval following path");
				//}}}
			case JSON_OBJECT: //{{{
				{
					Tcl_Obj*	new = NULL;
					TEST_OK(Tcl_DictObjGet(interp, val, step, &new));
					replace_tclobj(target, new);
				}
				if (*target == NULL) {
					EXISTS(0);
					Tcl_SetObjResult(interp, Tcl_ObjPrintf("Path element %d: \"%s\" not found", pathc+1, Tcl_GetString(step)));
					return TCL_ERROR;



				}

				//TEST_OK(JSON_GetJvalFromObj(interp, src, &type, &val));
				//fprintf(stderr, "Descended into object, new type: %s, val: (%s)\n", type_names[type], Tcl_GetString(val));
				break;
				//}}}
			case JSON_ARRAY: //{{{