Artifact
ab0965236d5b1e8d6f0dae9156f5e5eaa9618fa0
File
json/parser.fs
— part of check-in
[030abcc712]
at
2019-01-21 14:03:31
on branch trunk
— Integrate importer into normal command line
(user:
bernd
size: 9149)
0000: 5c 20 4a 53 4f 4e 20 70 61 72 73 65 72 20 74 6f \ JSON parser to
0010: 20 69 6d 70 6f 72 74 20 47 6f 6f 67 6c 65 2b 0a import Google+.
0020: 0a 5c 20 43 6f 70 79 72 69 67 68 74 20 28 43 29 .\ Copyright (C)
0030: 20 32 30 31 38 20 20 20 42 65 72 6e 64 20 50 61 2018 Bernd Pa
0040: 79 73 61 6e 0a 0a 5c 20 54 68 69 73 20 70 72 6f ysan..\ This pro
0050: 67 72 61 6d 20 69 73 20 66 72 65 65 20 73 6f 66 gram is free sof
0060: 74 77 61 72 65 3a 20 79 6f 75 20 63 61 6e 20 72 tware: you can r
0070: 65 64 69 73 74 72 69 62 75 74 65 20 69 74 20 61 edistribute it a
0080: 6e 64 2f 6f 72 20 6d 6f 64 69 66 79 0a 5c 20 69 nd/or modify.\ i
0090: 74 20 75 6e 64 65 72 20 74 68 65 20 74 65 72 6d t under the term
00a0: 73 20 6f 66 20 74 68 65 20 47 4e 55 20 41 66 66 s of the GNU Aff
00b0: 65 72 6f 20 47 65 6e 65 72 61 6c 20 50 75 62 6c ero General Publ
00c0: 69 63 20 4c 69 63 65 6e 73 65 20 61 73 20 70 75 ic License as pu
00d0: 62 6c 69 73 68 65 64 20 62 79 0a 5c 20 74 68 65 blished by.\ the
00e0: 20 46 72 65 65 20 53 6f 66 74 77 61 72 65 20 46 Free Software F
00f0: 6f 75 6e 64 61 74 69 6f 6e 2c 20 65 69 74 68 65 oundation, eithe
0100: 72 20 76 65 72 73 69 6f 6e 20 33 20 6f 66 20 74 r version 3 of t
0110: 68 65 20 4c 69 63 65 6e 73 65 2c 20 6f 72 0a 5c he License, or.\
0120: 20 28 61 74 20 79 6f 75 72 20 6f 70 74 69 6f 6e (at your option
0130: 29 20 61 6e 79 20 6c 61 74 65 72 20 76 65 72 73 ) any later vers
0140: 69 6f 6e 2e 0a 0a 5c 20 54 68 69 73 20 70 72 6f ion...\ This pro
0150: 67 72 61 6d 20 69 73 20 64 69 73 74 72 69 62 75 gram is distribu
0160: 74 65 64 20 69 6e 20 74 68 65 20 68 6f 70 65 20 ted in the hope
0170: 74 68 61 74 20 69 74 20 77 69 6c 6c 20 62 65 20 that it will be
0180: 75 73 65 66 75 6c 2c 0a 5c 20 62 75 74 20 57 49 useful,.\ but WI
0190: 54 48 4f 55 54 20 41 4e 59 20 57 41 52 52 41 4e THOUT ANY WARRAN
01a0: 54 59 3b 20 77 69 74 68 6f 75 74 20 65 76 65 6e TY; without even
01b0: 20 74 68 65 20 69 6d 70 6c 69 65 64 20 77 61 72 the implied war
01c0: 72 61 6e 74 79 20 6f 66 0a 5c 20 4d 45 52 43 48 ranty of.\ MERCH
01d0: 41 4e 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 ANTABILITY or FI
01e0: 54 4e 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 TNESS FOR A PART
01f0: 49 43 55 4c 41 52 20 50 55 52 50 4f 53 45 2e 20 ICULAR PURPOSE.
0200: 20 53 65 65 20 74 68 65 0a 5c 20 47 4e 55 20 41 See the.\ GNU A
0210: 66 66 65 72 6f 20 47 65 6e 65 72 61 6c 20 50 75 ffero General Pu
0220: 62 6c 69 63 20 4c 69 63 65 6e 73 65 20 66 6f 72 blic License for
0230: 20 6d 6f 72 65 20 64 65 74 61 69 6c 73 2e 0a 0a more details...
0240: 5c 20 59 6f 75 20 73 68 6f 75 6c 64 20 68 61 76 \ You should hav
0250: 65 20 72 65 63 65 69 76 65 64 20 61 20 63 6f 70 e received a cop
0260: 79 20 6f 66 20 74 68 65 20 47 4e 55 20 41 66 66 y of the GNU Aff
0270: 65 72 6f 20 47 65 6e 65 72 61 6c 20 50 75 62 6c ero General Publ
0280: 69 63 20 4c 69 63 65 6e 73 65 0a 5c 20 61 6c 6f ic License.\ alo
0290: 6e 67 20 77 69 74 68 20 74 68 69 73 20 70 72 6f ng with this pro
02a0: 67 72 61 6d 2e 20 20 49 66 20 6e 6f 74 2c 20 73 gram. If not, s
02b0: 65 65 20 3c 68 74 74 70 3a 2f 2f 77 77 77 2e 67 ee <http://www.g
02c0: 6e 75 2e 6f 72 67 2f 6c 69 63 65 6e 73 65 73 2f nu.org/licenses/
02d0: 3e 2e 0a 0a 72 65 71 75 69 72 65 20 2e 2e 2f 74 >...require ../t
02e0: 6f 6f 6c 73 2e 66 73 0a 73 63 6f 70 65 3a 20 72 ools.fs.scope: r
02f0: 65 67 65 78 70 73 0a 72 65 71 75 69 72 65 20 72 egexps.require r
0300: 65 67 65 78 70 2e 66 73 0a 7d 73 63 6f 70 65 0a egexp.fs.}scope.
0310: 0a 61 6c 73 6f 20 72 65 67 65 78 70 73 0a 43 68 .also regexps.Ch
0320: 61 72 63 6c 61 73 73 20 5b 62 6c 54 5d 20 62 6c arclass [blT] bl
0330: 20 2b 63 68 61 72 20 27 54 27 20 2b 63 68 61 72 +char 'T' +char
0340: 0a 3a 20 69 73 6f 2d 3f 64 61 74 65 20 28 20 61 .: iso-?date ( a
0350: 64 64 72 20 75 20 2d 2d 20 66 6c 61 67 20 29 0a ddr u -- flag ).
0360: 20 20 20 20 28 28 20 5c 28 20 5c 64 20 5c 64 20 (( \( \d \d
0370: 5c 64 20 5c 64 20 5c 29 20 60 20 2d 20 5c 28 20 \d \d \) ` - \(
0380: 5c 64 20 5c 64 20 5c 29 20 60 20 2d 20 5c 28 20 \d \d \) ` - \(
0390: 5c 64 20 5c 64 20 5c 29 0a 20 20 20 20 7b 7b 20 \d \d \). {{
03a0: 5b 62 6c 54 5d 20 63 3f 0a 20 20 20 20 5c 28 20 [blT] c?. \(
03b0: 5c 64 20 5c 64 20 5c 29 20 60 20 3a 20 5c 28 20 \d \d \) ` : \(
03c0: 5c 64 20 5c 64 20 5c 29 20 60 20 3a 20 5c 28 20 \d \d \) ` : \(
03d0: 5c 64 20 5c 64 20 5c 29 0a 20 20 20 20 7b 7b 20 \d \d \). {{
03e0: 60 20 2e 20 5c 28 20 7b 2b 2b 20 5c 64 20 5c 64 ` . \( {++ \d \d
03f0: 20 5c 64 20 2b 2b 7d 20 5c 29 20 7c 7c 20 5c 28 \d ++} \) || \(
0400: 20 5c 29 20 7d 7d 0a 20 20 20 20 7b 7b 20 60 20 \) }}. {{ `
0410: 5a 20 5c 28 20 5c 29 20 5c 28 20 5c 29 20 7c 7c Z \( \) \( \) ||
0420: 0a 20 20 20 20 20 20 20 7b 7b 20 60 20 2b 20 5c . {{ ` + \
0430: 28 20 7c 7c 20 5c 28 20 60 20 2d 20 7d 7d 20 5c ( || \( ` - }} \
0440: 64 20 5c 64 20 60 3f 20 3a 20 5c 64 20 5c 64 20 d \d `? : \d \d
0450: 5c 29 0a 20 20 20 20 7d 7d 20 7c 7c 20 5c 28 20 \). }} || \(
0460: 5c 29 20 5c 28 20 5c 29 20 5c 28 20 5c 29 20 5c \) \( \) \( \) \
0470: 28 20 5c 29 20 5c 28 20 5c 29 20 7d 7d 20 5c 24 ( \) \( \) }} \$
0480: 20 29 29 20 3b 0a 3a 20 69 73 6f 2d 64 61 74 65 )) ;.: iso-date
0490: 3e 74 69 63 6b 73 20 28 20 2d 2d 20 74 69 63 6b >ticks ( -- tick
04a0: 73 20 29 0a 20 20 20 20 5c 31 20 73 3e 6e 75 6d s ). \1 s>num
04b0: 62 65 72 20 64 72 6f 70 20 5c 32 20 73 3e 6e 75 ber drop \2 s>nu
04c0: 6d 62 65 72 20 64 72 6f 70 20 5c 33 20 73 3e 6e mber drop \3 s>n
04d0: 75 6d 62 65 72 20 64 72 6f 70 20 79 6d 64 32 64 umber drop ymd2d
04e0: 61 79 20 75 6e 69 78 2d 64 61 79 30 20 2d 0a 20 ay unix-day0 -.
04f0: 20 20 20 23 32 34 20 2a 0a 20 20 20 20 5c 34 20 #24 *. \4
0500: 73 3e 6e 75 6d 62 65 72 20 64 72 6f 70 20 2b 20 s>number drop +
0510: 23 36 30 20 2a 20 5c 35 20 73 3e 6e 75 6d 62 65 #60 * \5 s>numbe
0520: 72 20 64 72 6f 70 20 2b 0a 20 20 20 20 5c 38 20 r drop +. \8
0530: 32 20 75 6d 69 6e 20 73 3e 6e 75 6d 62 65 72 20 2 umin s>number
0540: 64 72 6f 70 20 20 20 23 36 30 20 2a 0a 20 20 20 drop #60 *.
0550: 20 5c 38 20 64 75 70 20 32 20 2d 20 2f 73 74 72 \8 dup 2 - /str
0560: 69 6e 67 20 73 3e 75 6e 75 6d 62 65 72 3f 20 32 ing s>unumber? 2
0570: 64 72 6f 70 20 6f 76 65 72 20 30 3c 20 49 46 20 drop over 0< IF
0580: 2d 20 45 4c 53 45 20 2b 20 54 48 45 4e 20 2d 0a - ELSE + THEN -.
0590: 20 20 20 20 23 36 30 20 2a 20 5c 36 20 73 3e 6e #60 * \6 s>n
05a0: 75 6d 62 65 72 20 64 72 6f 70 20 2b 0a 20 20 20 umber drop +.
05b0: 20 23 31 30 30 30 30 30 30 30 30 30 20 75 6d 2a #1000000000 um*
05c0: 0a 20 20 20 20 5c 37 20 73 3e 75 6e 75 6d 62 65 . \7 s>unumbe
05d0: 72 3f 20 32 64 72 6f 70 0a 20 20 20 20 63 61 73 r? 2drop. cas
05e0: 65 20 5c 37 20 6e 69 70 0a 09 33 20 6f 66 20 20 e \7 nip..3 of
05f0: 23 31 30 30 30 30 30 30 20 75 6d 2a 20 20 65 6e #1000000 um* en
0600: 64 6f 66 0a 09 36 20 6f 66 20 20 23 31 30 30 30 dof..6 of #1000
0610: 20 20 20 20 75 6d 2a 20 20 65 6e 64 6f 66 0a 09 um* endof..
0620: 30 20 73 77 61 70 0a 20 20 20 20 65 6e 64 63 61 0 swap. endca
0630: 73 65 20 20 64 2b 0a 20 20 20 20 64 3e 36 34 20 se d+. d>64
0640: 3b 0a 70 72 65 76 69 6f 75 73 0a 0a 44 65 66 65 ;.previous..Defe
0650: 72 20 3f 64 61 74 65 0a 44 65 66 65 72 20 64 61 r ?date.Defer da
0660: 74 65 3e 74 69 63 6b 73 0a 0a 3a 20 69 73 6f 2d te>ticks..: iso-
0670: 64 61 74 65 0a 20 20 20 20 5b 27 5d 20 69 73 6f date. ['] iso
0680: 2d 3f 64 61 74 65 20 69 73 20 3f 64 61 74 65 0a -?date is ?date.
0690: 20 20 20 20 5b 27 5d 20 69 73 6f 2d 64 61 74 65 ['] iso-date
06a0: 3e 74 69 63 6b 73 20 69 73 20 64 61 74 65 3e 74 >ticks is date>t
06b0: 69 63 6b 73 20 3b 0a 0a 24 56 61 72 69 61 62 6c icks ;..$Variabl
06c0: 65 20 6b 65 79 24 20 5c 20 6b 65 79 20 73 74 72 e key$ \ key str
06d0: 69 6e 67 0a 32 35 36 20 63 65 6c 6c 73 20 62 75 ing.256 cells bu
06e0: 66 66 65 72 3a 20 6a 73 6f 6e 2d 74 6f 6b 65 6e ffer: json-token
06f0: 73 0a 35 20 73 74 61 63 6b 3a 20 6a 73 6f 6e 73 s.5 stack: jsons
0700: 2d 72 65 63 6f 67 6e 69 7a 65 72 0a 31 20 73 74 -recognizer.1 st
0710: 61 63 6b 3a 20 6a 73 6f 6e 2d 72 65 63 6f 67 6e ack: json-recogn
0720: 69 7a 65 72 0a 0a 27 20 6e 6f 6f 70 20 27 20 6c izer..' noop ' l
0730: 69 74 2c 20 64 75 70 20 72 65 63 74 79 70 65 3a it, dup rectype:
0740: 20 72 65 63 74 79 70 65 2d 62 6f 6f 6c 0a 27 20 rectype-bool.'
0750: 6e 6f 6f 70 20 27 20 6c 69 74 2c 20 64 75 70 20 noop ' lit, dup
0760: 72 65 63 74 79 70 65 3a 20 72 65 63 74 79 70 65 rectype: rectype
0770: 2d 6e 69 6c 0a 0a 73 22 20 4a 53 4f 4e 20 65 72 -nil..s" JSON er
0780: 72 6f 72 22 20 65 78 63 65 70 74 69 6f 6e 20 56 ror" exception V
0790: 61 6c 75 65 20 6a 73 6f 6e 2d 74 68 72 6f 77 0a alue json-throw.
07a0: 73 22 20 4a 53 4f 4e 20 6b 65 79 20 6e 6f 74 20 s" JSON key not
07b0: 66 6f 75 6e 64 22 20 65 78 63 65 70 74 69 6f 6e found" exception
07c0: 20 56 61 6c 75 65 20 6a 73 6f 6e 2d 6b 65 79 2d Value json-key-
07d0: 74 68 72 6f 77 0a 73 22 20 4a 53 4f 4e 20 63 6c throw.s" JSON cl
07e0: 61 73 73 20 6e 6f 74 20 66 6f 75 6e 64 22 20 65 ass not found" e
07f0: 78 63 65 70 74 69 6f 6e 20 56 61 6c 75 65 20 6a xception Value j
0800: 73 6f 6e 2d 63 6c 61 73 73 2d 74 68 72 6f 77 0a son-class-throw.
0810: 0a 3a 20 6a 73 6f 6e 2d 65 72 72 20 20 63 72 20 .: json-err cr
0820: 6f 72 64 65 72 20 6a 73 6f 6e 2d 74 68 72 6f 77 order json-throw
0830: 20 74 68 72 6f 77 20 3b 0a 0a 30 20 56 61 6c 75 throw ;..0 Valu
0840: 65 20 73 63 68 65 6d 61 2d 73 63 6f 70 65 0a 30 e schema-scope.0
0850: 20 56 61 6c 75 65 20 6f 75 74 65 72 2d 63 6c 61 Value outer-cla
0860: 73 73 0a 30 20 56 61 6c 75 65 20 73 63 68 65 6d ss.0 Value schem
0870: 61 2d 77 69 64 0a 0a 44 65 66 65 72 20 70 72 6f a-wid..Defer pro
0880: 63 65 73 73 2d 65 6c 65 6d 65 6e 74 20 20 27 20 cess-element '
0890: 6e 6f 6f 70 20 69 73 20 70 72 6f 63 65 73 73 2d noop is process-
08a0: 65 6c 65 6d 65 6e 74 0a 44 65 66 65 72 20 70 72 element.Defer pr
08b0: 6f 63 65 73 73 2d 65 6c 65 6d 65 6e 74 73 20 27 ocess-elements '
08c0: 20 6e 6f 6f 70 20 69 73 20 70 72 6f 63 65 73 73 noop is process
08d0: 2d 65 6c 65 6d 65 6e 74 73 0a 0a 72 65 71 75 69 -elements..requi
08e0: 72 65 20 67 2b 2d 73 63 68 65 6d 61 2e 66 73 0a re g+-schema.fs.
08f0: 72 65 71 75 69 72 65 20 66 62 2d 73 63 68 65 6d require fb-schem
0900: 61 2e 66 73 0a 72 65 71 75 69 72 65 20 74 77 69 a.fs.require twi
0910: 74 74 65 72 2d 73 63 68 65 6d 61 2e 66 73 0a 72 tter-schema.fs.r
0920: 65 71 75 69 72 65 20 64 69 61 73 70 6f 72 61 2d equire diaspora-
0930: 73 63 68 65 6d 61 2e 66 73 0a 0a 24 31 30 20 73 schema.fs..$10 s
0940: 74 61 63 6b 3a 20 65 6c 65 6d 65 6e 74 2d 73 74 tack: element-st
0950: 61 63 6b 0a 24 31 30 20 73 74 61 63 6b 3a 20 6b ack.$10 stack: k
0960: 65 79 2d 73 74 61 63 6b 0a 24 31 30 20 73 74 61 ey-stack.$10 sta
0970: 63 6b 3a 20 61 72 72 61 79 2d 73 74 61 63 6b 0a ck: array-stack.
0980: 30 20 56 61 6c 75 65 20 61 72 72 61 79 2d 69 74 0 Value array-it
0990: 65 6d 0a 30 20 56 61 6c 75 65 20 6c 61 73 74 2d em.0 Value last-
09a0: 74 79 70 65 0a 30 20 56 61 6c 75 65 20 70 72 65 type.0 Value pre
09b0: 76 69 6f 75 73 2d 74 79 70 65 0a 0a 3a 20 73 65 vious-type..: se
09c0: 74 2d 76 61 6c 20 28 20 76 61 6c 75 65 20 2d 2d t-val ( value --
09d0: 20 29 0a 20 20 20 20 6b 65 79 24 20 24 40 20 66 ). key$ $@ f
09e0: 69 6e 64 2d 6e 61 6d 65 20 3f 64 75 70 2d 49 46 ind-name ?dup-IF
09f0: 20 20 28 69 6e 74 2d 74 6f 29 20 20 45 58 49 54 (int-to) EXIT
0a00: 20 20 54 48 45 4e 0a 20 20 20 20 6a 73 6f 6e 2d THEN. json-
0a10: 65 72 72 20 3b 0a 0a 3a 20 73 65 74 2d 69 6e 74 err ;..: set-int
0a20: 20 28 20 76 61 6c 75 65 20 2d 2d 20 29 0a 20 20 ( value -- ).
0a30: 20 20 6b 65 79 24 20 24 40 20 66 69 6e 64 2d 6e key$ $@ find-n
0a40: 61 6d 65 20 3f 64 75 70 2d 49 46 20 20 28 69 6e ame ?dup-IF (in
0a50: 74 2d 74 6f 29 20 20 45 58 49 54 20 20 54 48 45 t-to) EXIT THE
0a60: 4e 0a 20 20 20 20 27 25 27 20 6b 65 79 24 20 24 N. '%' key$ $
0a70: 40 20 2b 20 31 2d 20 63 21 20 20 6b 65 79 24 20 @ + 1- c! key$
0a80: 24 40 20 66 69 6e 64 2d 6e 61 6d 65 20 3f 64 75 $@ find-name ?du
0a90: 70 2d 49 46 0a 09 3e 72 20 73 3e 66 20 72 3e 20 p-IF..>r s>f r>
0aa0: 28 69 6e 74 2d 74 6f 29 20 45 58 49 54 20 20 54 (int-to) EXIT T
0ab0: 48 45 4e 0a 20 20 20 20 27 21 27 20 6b 65 79 24 HEN. '!' key$
0ac0: 20 24 40 20 2b 20 31 2d 20 63 21 20 20 6b 65 79 $@ + 1- c! key
0ad0: 24 20 24 40 20 66 69 6e 64 2d 6e 61 6d 65 20 3f $ $@ find-name ?
0ae0: 64 75 70 2d 49 46 0a 09 3e 72 20 23 31 30 30 30 dup-IF..>r #1000
0af0: 30 30 30 30 30 30 20 75 6d 2a 20 64 3e 36 34 20 000000 um* d>64
0b00: 72 3e 20 28 69 6e 74 2d 74 6f 29 20 45 58 49 54 r> (int-to) EXIT
0b10: 20 20 54 48 45 4e 0a 20 20 20 20 6a 73 6f 6e 2d THEN. json-
0b20: 65 72 72 20 3b 0a 0a 44 65 66 65 72 20 6e 65 78 err ;..Defer nex
0b30: 74 2d 65 6c 65 6d 65 6e 74 0a 0a 3a 20 6e 65 78 t-element..: nex
0b40: 74 2d 65 6c 65 6d 65 6e 74 23 20 28 20 65 6c 65 t-element# ( ele
0b50: 6d 65 6e 74 20 2d 2d 20 29 0a 20 20 20 20 61 72 ment -- ). ar
0b60: 72 61 79 2d 69 74 65 6d 20 3f 64 75 70 2d 49 46 ray-item ?dup-IF
0b70: 20 20 3e 72 0a 09 63 61 73 65 20 70 72 65 76 69 >r..case previ
0b80: 6f 75 73 2d 74 79 70 65 0a 09 20 20 20 20 72 65 ous-type.. re
0b90: 63 74 79 70 65 2d 6e 61 6d 65 20 20 20 6f 66 20 ctype-name of
0ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0bb0: 20 20 65 6e 64 6f 66 0a 09 20 20 20 20 72 65 63 endof.. rec
0bc0: 74 79 70 65 2d 6e 75 6d 20 20 20 20 6f 66 20 20 type-num of
0bd0: 20 20 20 20 20 20 72 40 20 3e 73 74 61 63 6b 20 r@ >stack
0be0: 20 65 6e 64 6f 66 0a 09 20 20 20 20 72 65 63 74 endof.. rect
0bf0: 79 70 65 2d 64 6e 75 6d 20 20 20 6f 66 20 20 64 ype-dnum of d
0c00: 72 6f 70 20 20 72 40 20 3e 73 74 61 63 6b 20 20 rop r@ >stack
0c10: 65 6e 64 6f 66 0a 09 20 20 20 20 72 65 63 74 79 endof.. recty
0c20: 70 65 2d 73 74 72 69 6e 67 20 6f 66 20 20 73 3e pe-string of s>
0c30: 6e 75 6d 62 65 72 3f 20 30 3d 20 49 46 20 6a 73 number? 0= IF js
0c40: 6f 6e 2d 65 72 72 20 54 48 45 4e 0a 09 09 64 72 on-err THEN...dr
0c50: 6f 70 20 72 40 20 3e 73 74 61 63 6b 20 20 65 6e op r@ >stack en
0c60: 64 6f 66 0a 09 20 20 20 20 72 65 63 74 79 70 65 dof.. rectype
0c70: 2d 66 6c 6f 61 74 20 20 6f 66 20 20 66 3e 73 20 -float of f>s
0c80: 20 20 72 40 20 3e 73 74 61 63 6b 20 20 65 6e 64 r@ >stack end
0c90: 6f 66 0a 09 20 20 20 20 72 65 63 74 79 70 65 2d of.. rectype-
0ca0: 62 6f 6f 6c 20 20 20 6f 66 20 20 20 20 20 20 20 bool of
0cb0: 20 72 40 20 3e 73 74 61 63 6b 20 20 65 6e 64 6f r@ >stack endo
0cc0: 66 0a 09 20 20 20 20 72 65 63 74 79 70 65 2d 6e f.. rectype-n
0cd0: 69 6c 20 20 20 20 6f 66 20 20 20 20 20 20 20 20 il of
0ce0: 72 40 20 3e 73 74 61 63 6b 20 20 65 6e 64 6f 66 r@ >stack endof
0cf0: 0a 09 65 6e 64 63 61 73 65 20 20 72 64 72 6f 70 ..endcase rdrop
0d00: 0a 20 20 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 66 . THEN ;..: f
0d10: 3e 73 74 61 63 6b 20 28 20 72 20 73 74 61 63 6b >stack ( r stack
0d20: 20 2d 2d 20 29 0a 20 20 20 20 7b 20 66 5e 20 72 -- ). { f^ r
0d30: 20 7d 20 72 20 31 20 66 6c 6f 61 74 73 20 72 6f } r 1 floats ro
0d40: 74 20 24 2b 21 20 3b 0a 0a 3a 20 6e 65 78 74 2d t $+! ;..: next-
0d50: 65 6c 65 6d 65 6e 74 25 20 28 20 65 6c 65 6d 65 element% ( eleme
0d60: 6e 74 20 2d 2d 20 29 0a 20 20 20 20 61 72 72 61 nt -- ). arra
0d70: 79 2d 69 74 65 6d 20 3f 64 75 70 2d 49 46 20 20 y-item ?dup-IF
0d80: 3e 72 0a 09 63 61 73 65 20 70 72 65 76 69 6f 75 >r..case previou
0d90: 73 2d 74 79 70 65 0a 09 20 20 20 20 72 65 63 74 s-type.. rect
0da0: 79 70 65 2d 6e 61 6d 65 20 20 20 6f 66 20 20 20 ype-name of
0db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0dc0: 20 65 6e 64 6f 66 0a 09 20 20 20 20 72 65 63 74 endof.. rect
0dd0: 79 70 65 2d 66 6c 6f 61 74 20 20 6f 66 20 20 20 ype-float of
0de0: 20 20 20 20 20 72 40 20 66 3e 73 74 61 63 6b 20 r@ f>stack
0df0: 20 65 6e 64 6f 66 0a 09 20 20 20 20 72 65 63 74 endof.. rect
0e00: 79 70 65 2d 73 74 72 69 6e 67 20 6f 66 20 20 6f ype-string of o
0e10: 76 65 72 20 3e 72 20 3e 66 6c 6f 61 74 20 72 3e ver >r >float r>
0e20: 20 66 72 65 65 20 74 68 72 6f 77 0a 09 09 30 3d free throw...0=
0e30: 20 49 46 20 6a 73 6f 6e 2d 65 72 72 20 54 48 45 IF json-err THE
0e40: 4e 20 20 72 40 20 66 3e 73 74 61 63 6b 20 20 65 N r@ f>stack e
0e50: 6e 64 6f 66 0a 09 20 20 20 20 72 65 63 74 79 70 ndof.. rectyp
0e60: 65 2d 6e 75 6d 20 20 20 20 6f 66 20 20 73 3e 66 e-num of s>f
0e70: 20 20 20 72 40 20 66 3e 73 74 61 63 6b 20 20 65 r@ f>stack e
0e80: 6e 64 6f 66 0a 09 20 20 20 20 72 65 63 74 79 70 ndof.. rectyp
0e90: 65 2d 64 6e 75 6d 20 20 20 6f 66 20 20 64 3e 66 e-dnum of d>f
0ea0: 20 20 20 72 40 20 66 3e 73 74 61 63 6b 20 20 65 r@ f>stack e
0eb0: 6e 64 6f 66 0a 09 20 20 20 20 72 65 63 74 79 70 ndof.. rectyp
0ec0: 65 2d 62 6f 6f 6c 20 20 20 6f 66 20 20 73 3e 66 e-bool of s>f
0ed0: 20 20 20 72 40 20 66 3e 73 74 61 63 6b 20 20 65 r@ f>stack e
0ee0: 6e 64 6f 66 0a 09 20 20 20 20 72 65 63 74 79 70 ndof.. rectyp
0ef0: 65 2d 6e 69 6c 20 20 20 20 6f 66 20 20 73 3e 66 e-nil of s>f
0f00: 20 20 20 72 40 20 66 3e 73 74 61 63 6b 20 20 65 r@ f>stack e
0f10: 6e 64 6f 66 0a 09 65 6e 64 63 61 73 65 20 20 72 ndof..endcase r
0f20: 64 72 6f 70 0a 20 20 20 20 54 48 45 4e 20 3b 0a drop. THEN ;.
0f30: 0a 3a 20 6e 65 78 74 2d 65 6c 65 6d 65 6e 74 24 .: next-element$
0f40: 20 28 20 65 6c 65 6d 65 6e 74 20 2d 2d 20 29 0a ( element -- ).
0f50: 20 20 20 20 61 72 72 61 79 2d 69 74 65 6d 20 3f array-item ?
0f60: 64 75 70 2d 49 46 20 20 3e 72 0a 09 63 61 73 65 dup-IF >r..case
0f70: 20 70 72 65 76 69 6f 75 73 2d 74 79 70 65 0a 09 previous-type..
0f80: 20 20 20 20 72 65 63 74 79 70 65 2d 6e 61 6d 65 rectype-name
0f90: 20 20 20 6f 66 20 20 20 20 20 20 20 20 20 20 20 of
0fa0: 20 20 20 20 20 20 20 20 20 65 6e 64 6f 66 0a 09 endof..
0fb0: 20 20 20 20 72 65 63 74 79 70 65 2d 73 74 72 69 rectype-stri
0fc0: 6e 67 20 6f 66 20 20 6f 76 65 72 20 3e 72 20 24 ng of over >r $
0fd0: 6d 61 6b 65 20 72 3e 20 66 72 65 65 20 74 68 72 make r> free thr
0fe0: 6f 77 20 20 72 40 20 3e 73 74 61 63 6b 20 20 65 ow r@ >stack e
0ff0: 6e 64 6f 66 0a 09 20 20 20 20 72 65 63 74 79 70 ndof.. rectyp
1000: 65 2d 6e 75 6d 20 20 20 20 6f 66 20 20 5b 3a 20 e-num of [:
1010: 30 20 2e 72 20 3b 5d 20 24 74 6d 70 20 24 6d 61 0 .r ;] $tmp $ma
1020: 6b 65 20 72 40 20 3e 73 74 61 63 6b 20 20 65 6e ke r@ >stack en
1030: 64 6f 66 0a 09 20 20 20 20 72 65 63 74 79 70 65 dof.. rectype
1040: 2d 64 6e 75 6d 20 20 20 6f 66 20 20 5b 3a 20 30 -dnum of [: 0
1050: 20 64 2e 72 20 3b 5d 20 24 74 6d 70 20 24 6d 61 d.r ;] $tmp $ma
1060: 6b 65 20 72 40 20 3e 73 74 61 63 6b 20 20 65 6e ke r@ >stack en
1070: 64 6f 66 0a 09 20 20 20 20 72 65 63 74 79 70 65 dof.. rectype
1080: 2d 66 6c 6f 61 74 20 20 6f 66 20 20 5b 27 5d 20 -float of [']
1090: 66 2e 20 24 74 6d 70 20 2d 74 72 61 69 6c 69 6e f. $tmp -trailin
10a0: 67 20 24 6d 61 6b 65 20 20 72 40 20 3e 73 74 61 g $make r@ >sta
10b0: 63 6b 20 20 65 6e 64 6f 66 0a 09 20 20 20 20 72 ck endof.. r
10c0: 65 63 74 79 70 65 2d 62 6f 6f 6c 20 20 20 6f 66 ectype-bool of
10d0: 20 20 49 46 20 22 74 72 75 65 22 20 45 4c 53 45 IF "true" ELSE
10e0: 20 22 66 61 6c 73 65 22 20 54 48 45 4e 20 24 6d "false" THEN $m
10f0: 61 6b 65 20 72 40 20 3e 73 74 61 63 6b 20 20 65 ake r@ >stack e
1100: 6e 64 6f 66 0a 09 20 20 20 20 72 65 63 74 79 70 ndof.. rectyp
1110: 65 2d 6e 69 6c 20 20 20 20 6f 66 20 20 72 40 20 e-nil of r@
1120: 3e 73 74 61 63 6b 20 20 65 6e 64 6f 66 0a 09 65 >stack endof..e
1130: 6e 64 63 61 73 65 20 20 72 64 72 6f 70 0a 20 20 ndcase rdrop.
1140: 20 20 54 48 45 4e 20 3b 0a 0a 27 20 6e 65 78 74 THEN ;..' next
1150: 2d 65 6c 65 6d 65 6e 74 24 20 69 73 20 6e 65 78 -element$ is nex
1160: 74 2d 65 6c 65 6d 65 6e 74 0a 0a 3a 20 62 65 67 t-element..: beg
1170: 69 6e 2d 65 6c 65 6d 65 6e 74 20 28 20 2d 2d 20 in-element ( --
1180: 29 0a 20 20 20 20 5c 20 27 22 27 20 65 6d 69 74 ). \ '"' emit
1190: 20 6b 65 79 24 20 24 2e 20 2e 5c 22 20 5c 22 3a key$ $. .\" \":
11a0: 20 7b 22 20 63 72 0a 20 20 20 20 6b 65 79 24 20 {" cr. key$
11b0: 24 40 20 73 63 68 65 6d 61 2d 73 63 6f 70 65 20 $@ schema-scope
11c0: 66 69 6e 64 2d 6e 61 6d 65 2d 69 6e 0a 20 20 20 find-name-in.
11d0: 20 3f 64 75 70 2d 49 46 20 20 6e 61 6d 65 3e 69 ?dup-IF name>i
11e0: 6e 74 20 3e 62 6f 64 79 20 3e 72 0a 09 5b 3a 20 nt >body >r..[:
11f0: 6b 65 79 24 20 24 2e 20 2e 22 20 2d 63 6c 61 73 key$ $. ." -clas
1200: 73 22 20 3b 5d 20 24 74 6d 70 20 73 63 68 65 6d s" ;] $tmp schem
1210: 61 2d 73 63 6f 70 65 20 66 69 6e 64 2d 6e 61 6d a-scope find-nam
1220: 65 2d 69 6e 0a 09 3f 64 75 70 2d 49 46 0a 09 20 e-in..?dup-IF..
1230: 20 20 20 6e 61 6d 65 3e 69 6e 74 20 65 78 65 63 name>int exec
1240: 75 74 65 20 6e 65 77 0a 09 20 20 20 20 64 75 70 ute new.. dup
1250: 20 61 72 72 61 79 2d 69 74 65 6d 20 3f 64 75 70 array-item ?dup
1260: 2d 49 46 0a 09 09 3e 73 74 61 63 6b 0a 09 20 20 -IF...>stack..
1270: 20 20 45 4c 53 45 0a 09 09 73 22 20 7b 7d 22 20 ELSE...s" {}"
1280: 6b 65 79 24 20 24 2b 21 20 73 65 74 2d 76 61 6c key$ $+! set-val
1290: 0a 09 20 20 20 20 54 48 45 4e 0a 09 20 20 20 20 .. THEN..
12a0: 3e 6f 20 72 3e 20 65 6c 65 6d 65 6e 74 2d 73 74 >o r> element-st
12b0: 61 63 6b 20 3e 73 74 61 63 6b 0a 09 20 20 20 20 ack >stack..
12c0: 6b 65 79 24 20 40 20 6b 65 79 2d 73 74 61 63 6b key$ @ key-stack
12d0: 20 3e 73 74 61 63 6b 20 6b 65 79 24 20 6f 66 66 >stack key$ off
12e0: 0a 09 20 20 20 20 67 65 74 2d 6f 72 64 65 72 20 .. get-order
12f0: 72 3e 20 73 77 61 70 20 31 2b 20 73 65 74 2d 6f r> swap 1+ set-o
1300: 72 64 65 72 0a 09 20 20 20 20 61 72 72 61 79 2d rder.. array-
1310: 69 74 65 6d 20 61 72 72 61 79 2d 73 74 61 63 6b item array-stack
1320: 20 3e 73 74 61 63 6b 20 30 20 74 6f 20 61 72 72 >stack 0 to arr
1330: 61 79 2d 69 74 65 6d 0a 09 45 4c 53 45 0a 09 20 ay-item..ELSE..
1340: 20 20 20 63 72 20 6b 65 79 24 20 24 2e 20 6a 73 cr key$ $. js
1350: 6f 6e 2d 63 6c 61 73 73 2d 74 68 72 6f 77 20 74 on-class-throw t
1360: 68 72 6f 77 0a 09 54 48 45 4e 0a 20 20 20 20 45 hrow..THEN. E
1370: 4c 53 45 0a 09 6b 65 79 24 20 24 40 6c 65 6e 20 LSE..key$ $@len
1380: 49 46 0a 09 20 20 20 20 63 72 20 6b 65 79 24 20 IF.. cr key$
1390: 24 2e 20 6a 73 6f 6e 2d 6b 65 79 2d 74 68 72 6f $. json-key-thro
13a0: 77 20 74 68 72 6f 77 0a 09 54 48 45 4e 0a 20 20 w throw..THEN.
13b0: 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 65 6e 64 2d THEN ;..: end-
13c0: 61 72 72 61 79 20 28 20 2d 2d 20 29 0a 20 20 20 array ( -- ).
13d0: 20 6e 65 78 74 2d 65 6c 65 6d 65 6e 74 0a 20 20 next-element.
13e0: 20 20 61 72 72 61 79 2d 73 74 61 63 6b 20 73 74 array-stack st
13f0: 61 63 6b 3e 20 74 6f 20 61 72 72 61 79 2d 69 74 ack> to array-it
1400: 65 6d 20 3b 0a 3a 20 65 6e 64 2d 65 6c 65 6d 65 em ;.: end-eleme
1410: 6e 74 20 28 20 2d 2d 20 29 0a 20 20 20 20 6b 65 nt ( -- ). ke
1420: 79 24 20 24 66 72 65 65 20 20 6b 65 79 2d 73 74 y$ $free key-st
1430: 61 63 6b 20 73 74 61 63 6b 3e 20 6b 65 79 24 20 ack stack> key$
1440: 21 0a 20 20 20 20 70 72 65 76 69 6f 75 73 20 65 !. previous e
1450: 6c 65 6d 65 6e 74 2d 73 74 61 63 6b 20 73 74 61 lement-stack sta
1460: 63 6b 3e 20 3e 6f 20 72 64 72 6f 70 20 20 65 6e ck> >o rdrop en
1470: 64 2d 61 72 72 61 79 20 3b 0a 3a 20 62 65 67 69 d-array ;.: begi
1480: 6e 2d 61 72 72 61 79 20 28 20 2d 2d 20 29 0a 20 n-array ( -- ).
1490: 20 20 20 61 72 72 61 79 2d 69 74 65 6d 20 61 72 array-item ar
14a0: 72 61 79 2d 73 74 61 63 6b 20 3e 73 74 61 63 6b ray-stack >stack
14b0: 0a 20 20 20 20 5b 3a 20 6b 65 79 24 20 24 2e 20 . [: key$ $.
14c0: 2e 22 20 5b 5d 22 20 3b 5d 20 24 74 6d 70 20 66 ." []" ;] $tmp f
14d0: 69 6e 64 2d 6e 61 6d 65 20 3f 64 75 70 2d 49 46 ind-name ?dup-IF
14e0: 0a 09 6e 61 6d 65 3e 69 6e 74 20 65 78 65 63 75 ..name>int execu
14f0: 74 65 20 74 6f 20 61 72 72 61 79 2d 69 74 65 6d te to array-item
1500: 0a 09 5b 27 5d 20 6e 65 78 74 2d 65 6c 65 6d 65 ..['] next-eleme
1510: 6e 74 24 20 69 73 20 6e 65 78 74 2d 65 6c 65 6d nt$ is next-elem
1520: 65 6e 74 20 20 45 58 49 54 20 20 54 48 45 4e 0a ent EXIT THEN.
1530: 20 20 20 20 5b 3a 20 6b 65 79 24 20 24 2e 20 2e [: key$ $. .
1540: 22 20 5b 5d 23 22 20 3b 5d 20 24 74 6d 70 20 66 " []#" ;] $tmp f
1550: 69 6e 64 2d 6e 61 6d 65 20 3f 64 75 70 2d 49 46 ind-name ?dup-IF
1560: 0a 09 6e 61 6d 65 3e 69 6e 74 20 65 78 65 63 75 ..name>int execu
1570: 74 65 20 74 6f 20 61 72 72 61 79 2d 69 74 65 6d te to array-item
1580: 0a 09 5b 27 5d 20 6e 65 78 74 2d 65 6c 65 6d 65 ..['] next-eleme
1590: 6e 74 23 20 69 73 20 6e 65 78 74 2d 65 6c 65 6d nt# is next-elem
15a0: 65 6e 74 20 20 45 58 49 54 20 20 54 48 45 4e 0a ent EXIT THEN.
15b0: 20 20 20 20 5b 3a 20 6b 65 79 24 20 24 2e 20 2e [: key$ $. .
15c0: 22 20 5b 5d 25 22 20 3b 5d 20 24 74 6d 70 20 66 " []%" ;] $tmp f
15d0: 69 6e 64 2d 6e 61 6d 65 20 3f 64 75 70 2d 49 46 ind-name ?dup-IF
15e0: 0a 09 6e 61 6d 65 3e 69 6e 74 20 65 78 65 63 75 ..name>int execu
15f0: 74 65 20 74 6f 20 61 72 72 61 79 2d 69 74 65 6d te to array-item
1600: 0a 09 5b 27 5d 20 6e 65 78 74 2d 65 6c 65 6d 65 ..['] next-eleme
1610: 6e 74 25 20 69 73 20 6e 65 78 74 2d 65 6c 65 6d nt% is next-elem
1620: 65 6e 74 20 20 45 58 49 54 20 20 54 48 45 4e 0a ent EXIT THEN.
1630: 20 20 20 20 6a 73 6f 6e 2d 65 72 72 20 3b 0a 0a json-err ;..
1640: 3a 20 6b 65 79 2d 66 69 6e 64 3f 20 28 20 63 68 : key-find? ( ch
1650: 61 72 20 2d 2d 20 6e 74 20 29 0a 20 20 20 20 6b ar -- nt ). k
1660: 65 79 24 20 24 40 20 2b 20 31 2d 20 63 21 20 6b ey$ $@ + 1- c! k
1670: 65 79 24 20 24 40 20 66 69 6e 64 2d 6e 61 6d 65 ey$ $@ find-name
1680: 20 3b 0a 0a 3a 20 6a 73 6f 6e 2d 73 74 72 69 6e ;..: json-strin
1690: 67 21 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 g! ( addr u -- )
16a0: 0a 20 20 20 20 6f 76 65 72 20 3e 72 0a 20 20 20 . over >r.
16b0: 20 27 24 27 20 6b 65 79 24 20 63 24 2b 21 20 6b '$' key$ c$+! k
16c0: 65 79 24 20 24 40 20 66 69 6e 64 2d 6e 61 6d 65 ey$ $@ find-name
16d0: 20 3f 64 75 70 2d 49 46 20 20 28 69 6e 74 2d 74 ?dup-IF (int-t
16e0: 6f 29 20 72 3e 20 66 72 65 65 20 74 68 72 6f 77 o) r> free throw
16f0: 20 20 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 EXIT THEN.
1700: 20 5c 20 77 6f 72 6b 61 72 6f 75 6e 64 20 69 66 \ workaround if
1710: 20 79 6f 75 20 6d 65 61 6e 20 6e 75 6d 62 65 72 you mean number
1720: 20 62 75 74 20 77 72 6f 74 65 20 73 74 72 69 6e but wrote strin
1730: 67 0a 20 20 20 20 27 26 27 20 6b 65 79 2d 66 69 g. '&' key-fi
1740: 6e 64 3f 20 3f 64 75 70 2d 49 46 0a 09 3e 72 20 nd? ?dup-IF..>r
1750: 73 3e 6e 75 6d 62 65 72 3f 20 20 49 46 20 20 72 s>number? IF r
1760: 3e 20 28 69 6e 74 2d 74 6f 29 20 72 3e 20 66 72 > (int-to) r> fr
1770: 65 65 20 74 68 72 6f 77 20 20 45 58 49 54 20 20 ee throw EXIT
1780: 54 48 45 4e 20 20 6a 73 6f 6e 2d 65 72 72 20 20 THEN json-err
1790: 54 48 45 4e 0a 20 20 20 20 27 23 27 20 6b 65 79 THEN. '#' key
17a0: 2d 66 69 6e 64 3f 20 3f 64 75 70 2d 49 46 0a 09 -find? ?dup-IF..
17b0: 3e 72 20 73 3e 6e 75 6d 62 65 72 3f 20 20 49 46 >r s>number? IF
17c0: 20 20 64 72 6f 70 20 72 3e 20 28 69 6e 74 2d 74 drop r> (int-t
17d0: 6f 29 20 72 3e 20 66 72 65 65 20 74 68 72 6f 77 o) r> free throw
17e0: 20 20 45 58 49 54 20 20 54 48 45 4e 20 20 6a 73 EXIT THEN js
17f0: 6f 6e 2d 65 72 72 20 20 54 48 45 4e 0a 20 20 20 on-err THEN.
1800: 20 27 21 27 20 6b 65 79 2d 66 69 6e 64 3f 20 3f '!' key-find? ?
1810: 64 75 70 2d 49 46 20 20 64 72 6f 70 0a 09 3f 64 dup-IF drop..?d
1820: 61 74 65 20 49 46 20 20 64 61 74 65 3e 74 69 63 ate IF date>tic
1830: 6b 73 20 73 65 74 2d 76 61 6c 20 72 3e 20 66 72 ks set-val r> fr
1840: 65 65 20 74 68 72 6f 77 20 20 45 58 49 54 20 20 ee throw EXIT
1850: 54 48 45 4e 20 20 6a 73 6f 6e 2d 65 72 72 20 20 THEN json-err
1860: 54 48 45 4e 0a 20 20 20 20 27 25 27 20 6b 65 79 THEN. '%' key
1870: 2d 66 69 6e 64 3f 20 3f 64 75 70 2d 49 46 20 20 -find? ?dup-IF
1880: 64 72 6f 70 0a 09 3e 66 6c 6f 61 74 20 49 46 20 drop..>float IF
1890: 20 73 65 74 2d 76 61 6c 20 72 3e 20 66 72 65 65 set-val r> free
18a0: 20 74 68 72 6f 77 20 20 45 58 49 54 20 20 54 48 throw EXIT TH
18b0: 45 4e 20 20 6a 73 6f 6e 2d 65 72 72 20 20 54 48 EN json-err TH
18c0: 45 4e 0a 20 20 20 20 72 3e 20 66 72 65 65 20 74 EN. r> free t
18d0: 68 72 6f 77 20 6a 73 6f 6e 2d 65 72 72 20 3b 0a hrow json-err ;.
18e0: 0a 3a 20 65 76 61 6c 2d 6a 73 6f 6e 20 28 20 2e .: eval-json ( .
18f0: 2e 20 74 61 67 20 2d 2d 20 29 0a 20 20 20 20 63 . tag -- ). c
1900: 61 73 65 0a 09 72 65 63 74 79 70 65 2d 6e 61 6d ase..rectype-nam
1910: 65 20 20 20 6f 66 20 20 6e 61 6d 65 3f 69 6e 74 e of name?int
1920: 20 65 78 65 63 75 74 65 20 20 20 20 20 20 20 65 execute e
1930: 6e 64 6f 66 0a 09 72 65 63 74 79 70 65 2d 73 74 ndof..rectype-st
1940: 72 69 6e 67 20 6f 66 20 20 6a 73 6f 6e 2d 73 74 ring of json-st
1950: 72 69 6e 67 21 20 20 20 20 20 20 20 20 20 20 20 ring!
1960: 65 6e 64 6f 66 0a 09 72 65 63 74 79 70 65 2d 6e endof..rectype-n
1970: 75 6d 20 20 20 20 6f 66 20 20 27 23 27 20 6b 65 um of '#' ke
1980: 79 24 20 63 24 2b 21 20 73 65 74 2d 69 6e 74 20 y$ c$+! set-int
1990: 20 65 6e 64 6f 66 0a 09 72 65 63 74 79 70 65 2d endof..rectype-
19a0: 64 6e 75 6d 20 20 20 6f 66 20 20 27 26 27 20 6b dnum of '&' k
19b0: 65 79 24 20 63 24 2b 21 20 73 65 74 2d 76 61 6c ey$ c$+! set-val
19c0: 20 20 65 6e 64 6f 66 0a 09 72 65 63 74 79 70 65 endof..rectype
19d0: 2d 66 6c 6f 61 74 20 20 6f 66 20 20 27 25 27 20 -float of '%'
19e0: 6b 65 79 24 20 63 24 2b 21 20 73 65 74 2d 76 61 key$ c$+! set-va
19f0: 6c 20 20 65 6e 64 6f 66 0a 09 72 65 63 74 79 70 l endof..rectyp
1a00: 65 2d 62 6f 6f 6c 20 20 20 6f 66 20 20 27 3f 27 e-bool of '?'
1a10: 20 6b 65 79 24 20 63 24 2b 21 20 73 65 74 2d 76 key$ c$+! set-v
1a20: 61 6c 20 20 65 6e 64 6f 66 0a 09 72 65 63 74 79 al endof..recty
1a30: 70 65 2d 6e 69 6c 20 20 20 20 6f 66 20 20 64 72 pe-nil of dr
1a40: 6f 70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 op
1a50: 20 20 20 20 20 65 6e 64 6f 66 20 5c 20 64 65 66 endof \ def
1a60: 61 75 6c 74 20 69 73 20 6e 75 6c 6c 2c 20 61 6e ault is null, an
1a70: 79 68 6f 77 0a 09 6a 73 6f 6e 2d 65 72 72 0a 20 yhow..json-err.
1a80: 20 20 20 65 6e 64 63 61 73 65 20 3b 0a 0a 3a 20 endcase ;..:
1a90: 6b 65 79 2d 76 61 6c 75 65 20 28 20 61 64 64 72 key-value ( addr
1aa0: 20 75 20 2d 2d 20 29 20 6f 76 65 72 20 3e 72 20 u -- ) over >r
1ab0: 6b 65 79 24 20 24 21 20 72 3e 20 66 72 65 65 20 key$ $! r> free
1ac0: 74 68 72 6f 77 0a 20 20 20 20 70 61 72 73 65 2d throw. parse-
1ad0: 6e 61 6d 65 20 6a 73 6f 6e 73 2d 72 65 63 6f 67 name jsons-recog
1ae0: 6e 69 7a 65 72 20 72 65 63 6f 67 6e 69 7a 65 20 nizer recognize
1af0: 65 76 61 6c 2d 6a 73 6f 6e 20 3b 0a 0a 27 20 62 eval-json ;..' b
1b00: 65 67 69 6e 2d 65 6c 65 6d 65 6e 74 20 27 7b 27 egin-element '{'
1b10: 20 63 65 6c 6c 73 20 6a 73 6f 6e 2d 74 6f 6b 65 cells json-toke
1b20: 6e 73 20 2b 20 21 0a 27 20 65 6e 64 2d 65 6c 65 ns + !.' end-ele
1b30: 6d 65 6e 74 20 20 20 27 7d 27 20 63 65 6c 6c 73 ment '}' cells
1b40: 20 6a 73 6f 6e 2d 74 6f 6b 65 6e 73 20 2b 20 21 json-tokens + !
1b50: 0a 27 20 6e 65 78 74 2d 65 6c 65 6d 65 6e 74 20 .' next-element
1b60: 20 27 2c 27 20 63 65 6c 6c 73 20 6a 73 6f 6e 2d ',' cells json-
1b70: 74 6f 6b 65 6e 73 20 2b 20 21 0a 27 20 62 65 67 tokens + !.' beg
1b80: 69 6e 2d 61 72 72 61 79 20 20 20 27 5b 27 20 63 in-array '[' c
1b90: 65 6c 6c 73 20 6a 73 6f 6e 2d 74 6f 6b 65 6e 73 ells json-tokens
1ba0: 20 2b 20 21 0a 27 20 65 6e 64 2d 61 72 72 61 79 + !.' end-array
1bb0: 20 20 20 20 20 27 5d 27 20 63 65 6c 6c 73 20 6a ']' cells j
1bc0: 73 6f 6e 2d 74 6f 6b 65 6e 73 20 2b 20 21 0a 27 son-tokens + !.'
1bd0: 20 6b 65 79 2d 76 61 6c 75 65 20 20 20 20 20 27 key-value '
1be0: 3a 27 20 63 65 6c 6c 73 20 6a 73 6f 6e 2d 74 6f :' cells json-to
1bf0: 6b 65 6e 73 20 2b 20 21 0a 0a 3a 20 72 65 63 2d kens + !..: rec-
1c00: 6a 73 6f 6e 20 28 20 61 64 64 72 20 75 20 2d 2d json ( addr u --
1c10: 20 29 0a 20 20 20 20 31 20 3d 20 49 46 0a 09 63 ). 1 = IF..c
1c20: 40 20 63 65 6c 6c 73 20 6a 73 6f 6e 2d 74 6f 6b @ cells json-tok
1c30: 65 6e 73 20 2b 20 40 0a 09 64 75 70 20 49 46 20 ens + @..dup IF
1c40: 20 72 65 63 74 79 70 65 2d 6e 61 6d 65 20 20 45 rectype-name E
1c50: 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 54 48 XIT THEN. TH
1c60: 45 4e 0a 20 20 20 20 64 72 6f 70 20 72 65 63 74 EN. drop rect
1c70: 79 70 65 2d 6e 75 6c 6c 20 3b 0a 0a 32 35 36 20 ype-null ;..256
1c80: 62 75 66 66 65 72 3a 20 73 74 6f 70 2d 63 68 61 buffer: stop-cha
1c90: 72 73 0a 62 6c 20 31 2b 20 30 20 5b 64 6f 5d 20 rs.bl 1+ 0 [do]
1ca0: 31 20 73 74 6f 70 2d 63 68 61 72 73 20 5b 69 5d 1 stop-chars [i]
1cb0: 20 2b 20 63 21 20 5b 6c 6f 6f 70 5d 0a 22 7b 7d + c! [loop]."{}
1cc0: 5b 5d 2c 3a 5c 22 22 20 62 6f 75 6e 64 73 20 5b [],:\"" bounds [
1cd0: 64 6f 5d 20 31 20 73 74 6f 70 2d 63 68 61 72 73 do] 1 stop-chars
1ce0: 20 5b 69 5d 20 63 40 20 2b 20 63 21 20 5b 6c 6f [i] c@ + c! [lo
1cf0: 6f 70 5d 0a 0a 3a 20 70 61 72 73 65 2d 6a 73 6f op]..: parse-jso
1d00: 6e 20 28 20 2d 2d 20 61 64 64 72 20 75 20 29 0a n ( -- addr u ).
1d10: 20 20 20 20 73 6f 75 72 63 65 20 3e 69 6e 20 40 source >in @
1d20: 20 73 61 66 65 2f 73 74 72 69 6e 67 0a 20 20 20 safe/string.
1d30: 20 64 75 70 20 30 20 55 2b 44 4f 20 20 6f 76 65 dup 0 U+DO ove
1d40: 72 20 63 40 20 62 6c 20 75 3e 20 3f 4c 45 41 56 r c@ bl u> ?LEAV
1d50: 45 20 20 31 20 73 61 66 65 2f 73 74 72 69 6e 67 E 1 safe/string
1d60: 20 20 4c 4f 4f 50 0a 20 20 20 20 6f 76 65 72 20 LOOP. over
1d70: 63 40 20 73 74 6f 70 2d 63 68 61 72 73 20 2b 20 c@ stop-chars +
1d80: 63 40 20 20 49 46 20 20 31 20 75 6d 69 6e 20 20 c@ IF 1 umin
1d90: 45 4c 53 45 0a 09 64 75 70 20 31 20 55 2b 44 4f ELSE..dup 1 U+DO
1da0: 20 20 6f 76 65 72 20 49 20 2b 20 63 40 20 73 74 over I + c@ st
1db0: 6f 70 2d 63 68 61 72 73 20 2b 20 63 40 20 20 49 op-chars + c@ I
1dc0: 46 20 20 64 72 6f 70 20 49 20 20 4c 45 41 56 45 F drop I LEAVE
1dd0: 20 20 54 48 45 4e 20 20 4c 4f 4f 50 0a 20 20 20 THEN LOOP.
1de0: 20 54 48 45 4e 0a 20 20 20 20 32 64 75 70 20 2b THEN. 2dup +
1df0: 20 73 6f 75 72 63 65 20 64 72 6f 70 20 2d 20 3e source drop - >
1e00: 69 6e 20 21 20 32 64 75 70 20 69 6e 70 75 74 2d in ! 2dup input-
1e10: 6c 65 78 65 6d 65 21 20 3b 0a 0a 63 73 2d 73 63 lexeme! ;..cs-sc
1e20: 6f 70 65 3a 20 62 6f 6f 6c 73 0a 66 61 6c 73 65 ope: bools.false
1e30: 20 72 65 63 74 79 70 65 2d 62 6f 6f 6c 20 32 63 rectype-bool 2c
1e40: 6f 6e 73 74 61 6e 74 20 66 61 6c 73 65 0a 74 72 onstant false.tr
1e50: 75 65 20 20 72 65 63 74 79 70 65 2d 62 6f 6f 6c ue rectype-bool
1e60: 20 32 63 6f 6e 73 74 61 6e 74 20 74 72 75 65 0a 2constant true.
1e70: 30 20 20 20 20 20 72 65 63 74 79 70 65 2d 6e 69 0 rectype-ni
1e80: 6c 20 20 32 63 6f 6e 73 74 61 6e 74 20 6e 75 6c l 2constant nul
1e90: 6c 0a 7d 73 63 6f 70 65 0a 0a 3a 20 72 65 63 2d l.}scope..: rec-
1ea0: 62 6f 6f 6c 20 28 20 61 64 64 72 20 75 20 2d 2d bool ( addr u --
1eb0: 20 2e 2e 2e 20 29 0a 20 20 20 20 5b 27 5d 20 62 ... ). ['] b
1ec0: 6f 6f 6c 73 20 3e 62 6f 64 79 20 66 69 6e 64 2d ools >body find-
1ed0: 6e 61 6d 65 2d 69 6e 20 3f 64 75 70 2d 49 46 0a name-in ?dup-IF.
1ee0: 09 6e 61 6d 65 3e 69 6e 74 20 65 78 65 63 75 74 .name>int execut
1ef0: 65 0a 20 20 20 20 45 4c 53 45 20 20 72 65 63 74 e. ELSE rect
1f00: 79 70 65 2d 6e 75 6c 6c 20 20 54 48 45 4e 20 3b ype-null THEN ;
1f10: 0a 0a 27 20 72 65 63 2d 62 6f 6f 6c 20 27 20 72 ..' rec-bool ' r
1f20: 65 63 2d 6e 75 6d 20 27 20 72 65 63 2d 66 6c 6f ec-num ' rec-flo
1f30: 61 74 20 27 20 72 65 63 2d 73 74 72 69 6e 67 20 at ' rec-string
1f40: 27 20 72 65 63 2d 6a 73 6f 6e 0a 35 20 6a 73 6f ' rec-json.5 jso
1f50: 6e 73 2d 72 65 63 6f 67 6e 69 7a 65 72 20 73 65 ns-recognizer se
1f60: 74 2d 73 74 61 63 6b 0a 0a 3a 20 72 65 63 2d 6a t-stack..: rec-j
1f70: 73 6f 6e 73 20 28 20 61 64 64 72 20 75 20 2d 2d sons ( addr u --
1f80: 20 2e 2e 2e 20 6a 73 6f 6e 2d 74 79 70 65 20 29 ... json-type )
1f90: 0a 20 20 20 20 6c 61 73 74 2d 74 79 70 65 20 74 . last-type t
1fa0: 6f 20 70 72 65 76 69 6f 75 73 2d 74 79 70 65 0a o previous-type.
1fb0: 20 20 20 20 6a 73 6f 6e 73 2d 72 65 63 6f 67 6e jsons-recogn
1fc0: 69 7a 65 72 20 72 65 63 6f 67 6e 69 7a 65 20 64 izer recognize d
1fd0: 75 70 20 74 6f 20 6c 61 73 74 2d 74 79 70 65 20 up to last-type
1fe0: 3b 0a 0a 27 20 72 65 63 2d 6a 73 6f 6e 73 20 31 ;..' rec-jsons 1
1ff0: 20 6a 73 6f 6e 2d 72 65 63 6f 67 6e 69 7a 65 72 json-recognizer
2000: 20 73 65 74 2d 73 74 61 63 6b 0a 0a 3a 20 6a 73 set-stack..: js
2010: 6f 6e 2d 6c 6f 61 64 20 28 20 61 64 64 72 20 75 on-load ( addr u
2020: 20 2d 2d 20 6f 20 29 0a 20 20 20 20 6f 75 74 65 -- o ). oute
2030: 72 2d 63 6c 61 73 73 20 6e 65 77 20 3e 6f 0a 20 r-class new >o.
2040: 20 20 20 6f 20 65 6c 65 6d 65 6e 74 2d 73 74 61 o element-sta
2050: 63 6b 20 3e 73 74 61 63 6b 20 20 30 20 6b 65 79 ck >stack 0 key
2060: 2d 73 74 61 63 6b 20 3e 73 74 61 63 6b 20 20 30 -stack >stack 0
2070: 20 61 72 72 61 79 2d 73 74 61 63 6b 20 3e 73 74 array-stack >st
2080: 61 63 6b 0a 20 20 20 20 67 65 74 2d 6f 72 64 65 ack. get-orde
2090: 72 20 6e 3e 72 20 73 63 68 65 6d 61 2d 77 69 64 r n>r schema-wid
20a0: 20 31 20 73 65 74 2d 6f 72 64 65 72 0a 20 20 20 1 set-order.
20b0: 20 66 6f 72 74 68 2d 72 65 63 6f 67 6e 69 7a 65 forth-recognize
20c0: 72 20 3e 72 20 20 6a 73 6f 6e 2d 72 65 63 6f 67 r >r json-recog
20d0: 6e 69 7a 65 72 20 74 6f 20 66 6f 72 74 68 2d 72 nizer to forth-r
20e0: 65 63 6f 67 6e 69 7a 65 72 0a 20 20 20 20 61 63 ecognizer. ac
20f0: 74 69 6f 6e 2d 6f 66 20 70 61 72 73 65 2d 6e 61 tion-of parse-na
2100: 6d 65 20 3e 72 20 5b 27 5d 20 70 61 72 73 65 2d me >r ['] parse-
2110: 6a 73 6f 6e 20 69 73 20 70 61 72 73 65 2d 6e 61 json is parse-na
2120: 6d 65 0a 20 20 20 20 5b 27 5d 20 69 6e 63 6c 75 me. ['] inclu
2130: 64 65 64 20 63 61 74 63 68 0a 20 20 20 20 72 3e ded catch. r>
2140: 20 69 73 20 70 61 72 73 65 2d 6e 61 6d 65 20 20 is parse-name
2150: 72 3e 20 74 6f 20 66 6f 72 74 68 2d 72 65 63 6f r> to forth-reco
2160: 67 6e 69 7a 65 72 20 20 6e 72 3e 20 73 65 74 2d gnizer nr> set-
2170: 6f 72 64 65 72 0a 20 20 20 20 74 68 72 6f 77 20 order. throw
2180: 70 72 6f 63 65 73 73 2d 65 6c 65 6d 65 6e 74 20 process-element
2190: 6f 20 6f 3e 20 3b 0a 0a 3a 20 6a 73 6f 6e 2d 6c o o> ;..: json-l
21a0: 6f 61 64 2d 64 69 72 20 28 20 61 64 64 72 20 75 oad-dir ( addr u
21b0: 20 2d 2d 20 29 0a 20 20 20 20 32 64 75 70 20 6f -- ). 2dup o
21c0: 70 65 6e 2d 64 69 72 20 74 68 72 6f 77 20 7b 20 pen-dir throw {
21d0: 64 64 20 7d 20 66 70 61 74 68 20 64 75 70 20 24 dd } fpath dup $
21e0: 40 6c 65 6e 20 3e 72 20 61 6c 73 6f 2d 70 61 74 @len >r also-pat
21f0: 68 20 64 64 0a 20 20 20 20 5b 3a 20 7b 20 64 64 h dd. [: { dd
2200: 20 7c 20 6e 6e 20 7d 20 21 74 69 6d 65 0a 09 42 | nn } !time..B
2210: 45 47 49 4e 0a 09 20 20 20 20 70 61 64 20 24 31 EGIN.. pad $1
2220: 30 30 20 64 64 20 72 65 61 64 2d 64 69 72 20 74 00 dd read-dir t
2230: 68 72 6f 77 20 20 57 48 49 4c 45 0a 09 09 70 61 hrow WHILE...pa
2240: 64 20 73 77 61 70 20 32 64 75 70 20 22 2a 2e 6a d swap 2dup "*.j
2250: 73 6f 6e 22 20 66 69 6c 65 6e 61 6d 65 2d 6d 61 son" filename-ma
2260: 74 63 68 20 49 46 0a 09 09 20 20 20 20 6a 73 6f tch IF... jso
2270: 6e 2d 6c 6f 61 64 20 65 6e 74 72 69 65 73 5b 5d n-load entries[]
2280: 20 3e 73 74 61 63 6b 20 20 31 20 2b 74 6f 20 6e >stack 1 +to n
2290: 6e 0a 09 09 20 20 20 20 6e 6e 20 23 33 37 20 6d n... nn #37 m
22a0: 6f 64 20 30 3d 20 49 46 0a 09 09 09 6e 6e 20 5b od 0= IF....nn [
22b0: 3a 20 2e 22 20 72 65 61 64 20 22 20 36 20 2e 72 : ." read " 6 .r
22c0: 20 2e 22 20 20 70 6f 73 74 69 6e 67 73 22 20 3b ." postings" ;
22d0: 5d 0a 09 09 09 77 61 72 6e 69 6e 67 2d 63 6f 6c ]....warning-col
22e0: 6f 72 20 63 6f 6c 6f 72 2d 65 78 65 63 75 74 65 or color-execute
22f0: 0a 09 09 09 23 2d 32 30 20 30 20 61 74 2d 64 65 ....#-20 0 at-de
2300: 6c 74 61 78 79 0a 09 09 20 20 20 20 54 48 45 4e ltaxy... THEN
2310: 0a 09 09 45 4c 53 45 20 20 32 64 72 6f 70 20 20 ...ELSE 2drop
2320: 54 48 45 4e 0a 09 52 45 50 45 41 54 20 20 64 72 THEN..REPEAT dr
2330: 6f 70 0a 09 6e 6e 20 5b 3a 20 2e 22 20 72 65 61 op..nn [: ." rea
2340: 64 20 22 20 36 20 2e 72 20 2e 22 20 20 70 6f 73 d " 6 .r ." pos
2350: 74 69 6e 67 73 20 69 6e 20 22 20 2e 74 69 6d 65 tings in " .time
2360: 20 3b 5d 0a 09 73 75 63 63 65 73 73 2d 63 6f 6c ;]..success-col
2370: 6f 72 20 63 6f 6c 6f 72 2d 65 78 65 63 75 74 65 or color-execute
2380: 20 63 72 20 3b 5d 20 63 61 74 63 68 0a 20 20 20 cr ;] catch.
2390: 20 72 3e 20 66 70 61 74 68 20 24 21 6c 65 6e 20 r> fpath $!len
23a0: 20 64 64 20 63 6c 6f 73 65 2d 64 69 72 20 74 68 dd close-dir th
23b0: 72 6f 77 20 20 74 68 72 6f 77 20 3b 0a row throw ;.