1 ! Copyright (C) 2006 Chris Double.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: kernel parser-combinators namespaces sequences promises strings
4 assocs math math.parser math.vectors math.functions math.order
5 lists lists.lazy hashtables ascii ;
8 ! Grammar for JSON from RFC 4627
12 : [<&>] ( quot -- quot )
13 { } make unclip [ <&> ] reduce ;
15 : [<|>] ( quot -- quot )
16 { } make unclip [ <|> ] reduce ;
18 LAZY: 'ws' ( -- parser )
24 LAZY: spaced ( parser -- parser )
25 'ws' swap &> 'ws' <& ;
27 LAZY: 'begin-array' ( -- parser )
30 LAZY: 'begin-object' ( -- parser )
33 LAZY: 'end-array' ( -- parser )
36 LAZY: 'end-object' ( -- parser )
39 LAZY: 'name-separator' ( -- parser )
42 LAZY: 'value-separator' ( -- parser )
45 LAZY: 'false' ( -- parser )
46 "false" token [ drop f ] <@ ;
48 LAZY: 'null' ( -- parser )
49 "null" token [ drop json-null ] <@ ;
51 LAZY: 'true' ( -- parser )
52 "true" token [ drop t ] <@ ;
54 LAZY: 'quot' ( -- parser )
57 LAZY: 'hex-digit' ( -- parser )
58 [ digit> ] satisfy [ digit> ] <@ ;
60 : hex-digits>ch ( digits -- ch )
61 0 [ swap 16 * + ] reduce ;
63 LAZY: 'string-char' ( -- parser )
65 "\\b" token [ drop 8 ] <@ <|>
66 "\\t" token [ drop CHAR: \t ] <@ <|>
67 "\\n" token [ drop CHAR: \n ] <@ <|>
68 "\\f" token [ drop 12 ] <@ <|>
69 "\\r" token [ drop CHAR: \r ] <@ <|>
70 "\\\"" token [ drop CHAR: " ] <@ <|>
71 "\\/" token [ drop CHAR: / ] <@ <|>
72 "\\\\" token [ drop CHAR: \\ ] <@ <|>
73 "\\u" token 'hex-digit' 4 exactly-n &>
74 [ hex-digits>ch ] <@ <|> ;
76 LAZY: 'string' ( -- parser )
79 'quot' <& [ >string ] <@ ;
83 LAZY: 'member' ( -- parser )
89 LAZY: 'object' ( -- parser )
91 'member' 'value-separator' list-of &>
92 'end-object' <& [ >hashtable ] <@ ;
94 LAZY: 'array' ( -- parser )
96 'value' 'value-separator' list-of &>
99 LAZY: 'minus' ( -- parser )
102 LAZY: 'plus' ( -- parser )
105 LAZY: 'sign' ( -- parser )
108 LAZY: 'zero' ( -- parser )
109 "0" token [ drop 0 ] <@ ;
111 LAZY: 'decimal-point' ( -- parser )
114 LAZY: 'digit1-9' ( -- parser )
117 CHAR: 1 CHAR: 9 between?
121 ] satisfy [ digit> ] <@ ;
123 LAZY: 'digit0-9' ( -- parser )
124 [ digit? ] satisfy [ digit> ] <@ ;
126 : decimal>integer ( seq -- num ) 10 digits>integer ;
128 LAZY: 'int' ( -- parser )
130 'digit1-9' 'digit0-9' <*> <&:> [ decimal>integer ] <@ <|> ;
132 LAZY: 'e' ( -- parser )
133 "e" token "E" token <|> ;
135 : sign-number ( pair -- number )
136 #! Pair is { minus? num }
137 #! Convert the json number value to a factor number
138 dup second swap first [ first "-" = [ -1 * ] when ] when* ;
140 LAZY: 'exp' ( -- parser )
143 'digit0-9' <+> [ decimal>integer ] <@ <&> [ sign-number ] <@ ;
145 : sequence>frac ( seq -- num )
146 #! { 1 2 3 } => 0.123
147 reverse 0 [ swap 10 / + ] reduce 10 / >float ;
149 LAZY: 'frac' ( -- parser )
150 'decimal-point' 'digit0-9' <+> &> [ sequence>frac ] <@ ;
152 : raise-to-power ( pair -- num )
153 #! Pair is { num exp }.
154 #! Multiply 'num' by 10^exp
155 dup second dup [ 10 swap first ^ swap first * ] [ drop first ] if ;
157 LAZY: 'number' ( -- parser )
159 [ 'int' , 'frac' 0 succeed <|> , ] [<&>] [ sum ] <@
160 'exp' <?> <&> [ raise-to-power ] <@ <&> [ sign-number ] <@ ;
162 LAZY: 'value' ( -- parser )
173 : json> ( string -- object )
174 #! Parse a json formatted string to a factor object
175 'value' parse dup nil? [
176 "Could not parse json" throw
178 car parse-result-parsed