json: fix for parser combinator changes

darcs
chris.double 2006-10-08 11:30:45 +00:00
parent 0c3a25fd4d
commit ca33aa9c60
1 changed files with 33 additions and 33 deletions

View File

@ -21,7 +21,7 @@
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
! !
USING: kernel namespaces sequences strings math hashtables parser-combinators ; USING: kernel namespaces sequences strings math hashtables parser-combinators lazy-lists ;
IN: json IN: json
! Grammar for JSON from RFC 4627 ! Grammar for JSON from RFC 4627
@ -33,87 +33,87 @@ USE: tools
: [<|>] ( quot - quot ) : [<|>] ( quot - quot )
{ } make unclip [ <|> ] reduce ; { } make unclip [ <|> ] reduce ;
: 'ws' ( -- parser ) LAZY: 'ws' ( -- parser )
" " token " " token
"\n" token <|> "\n" token <|>
"\r" token <|> "\r" token <|>
"\t" token <|> "\t" token <|>
"" token <|> ; "" token <|> ;
: spaced ( parser -- parser ) LAZY: spaced ( parser -- parser )
'ws' swap &> 'ws' <& ; 'ws' swap &> 'ws' <& ;
: 'begin-array' ( -- parser ) LAZY: 'begin-array' ( -- parser )
"[" token spaced ; "[" token spaced ;
: 'begin-object' ( -- parser ) LAZY: 'begin-object' ( -- parser )
"{" token spaced ; "{" token spaced ;
: 'end-array' ( -- parser ) LAZY: 'end-array' ( -- parser )
"]" token spaced ; "]" token spaced ;
: 'end-object' ( -- parser ) LAZY: 'end-object' ( -- parser )
"}" token spaced ; "}" token spaced ;
: 'name-separator' ( -- parser ) LAZY: 'name-separator' ( -- parser )
":" token spaced ; ":" token spaced ;
: 'value-separator' ( -- parser ) LAZY: 'value-separator' ( -- parser )
"," token spaced ; "," token spaced ;
: 'false' ( -- parser ) LAZY: 'false' ( -- parser )
"false" token ; "false" token ;
: 'null' ( -- parser ) LAZY: 'null' ( -- parser )
"null" token ; "null" token ;
: 'true' ( -- parser ) LAZY: 'true' ( -- parser )
"true" token ; "true" token ;
: 'quot' ( -- parser ) LAZY: 'quot' ( -- parser )
"\"" token ; "\"" token ;
: 'string' ( -- parser ) LAZY: 'string' ( -- parser )
'quot' 'quot'
[ quotable? ] satisfy <+> &> [ quotable? ] satisfy <+> &>
'quot' <& [ >string ] <@ ; 'quot' <& [ >string ] <@ ;
DEFER: 'value' DEFER: 'value'
: 'member' ( -- parser ) LAZY: 'member' ( -- parser )
'string' 'string'
'name-separator' <& 'name-separator' <&
[ 'value' call ] <&> ; 'value' <&> ;
: object>hashtable ( object -- hashtable ) : object>hashtable ( object -- hashtable )
#! Convert json object to hashtable #! Convert json object to hashtable
H{ } clone dup rot [ dup second swap first rot set-hash ] each-with ; H{ } clone dup rot [ dup second swap first rot set-hash ] each-with ;
: 'object' ( -- parser ) LAZY: 'object' ( -- parser )
'begin-object' 'begin-object'
'member' &> 'member' &>
'value-separator' 'member' &> <*> <&:> 'value-separator' 'member' &> <*> <&:>
'end-object' <& [ object>hashtable ] <@ ; 'end-object' <& [ object>hashtable ] <@ ;
: 'array' ( -- parser ) LAZY: 'array' ( -- parser )
'begin-array' 'begin-array'
[ 'value' call ] &> 'value' &>
'value-separator' [ 'value' call ] &> <*> <&:> 'value-separator' 'value' &> <*> <&:>
'end-array' <& ; 'end-array' <& ;
: 'minus' ( -- parser ) LAZY: 'minus' ( -- parser )
"-" token ; "-" token ;
: 'plus' ( -- parser ) LAZY: 'plus' ( -- parser )
"+" token ; "+" token ;
: 'zero' ( -- parser ) LAZY: 'zero' ( -- parser )
"0" token [ drop 0 ] <@ ; "0" token [ drop 0 ] <@ ;
: 'decimal-point' ( -- parser ) LAZY: 'decimal-point' ( -- parser )
"." token ; "." token ;
: 'digit1-9' ( -- parser ) LAZY: 'digit1-9' ( -- parser )
[ [
dup integer? [ dup integer? [
CHAR: 1 CHAR: 9 between? CHAR: 1 CHAR: 9 between?
@ -122,25 +122,25 @@ DEFER: 'value'
] if ] if
] satisfy [ digit> ] <@ ; ] satisfy [ digit> ] <@ ;
: 'digit0-9' ( -- parser ) LAZY: 'digit0-9' ( -- parser )
[ digit? ] satisfy [ digit> ] <@ ; [ digit? ] satisfy [ digit> ] <@ ;
: sequence>number ( seq -- num ) : sequence>number ( seq -- num )
#! { 1 2 3 } => 123 #! { 1 2 3 } => 123
0 [ swap 10 * + ] reduce ; 0 [ swap 10 * + ] reduce ;
: 'int' ( -- parser ) LAZY: 'int' ( -- parser )
'zero' 'zero'
'digit1-9' 'digit0-9' <*> <&:> [ sequence>number ] <@ <|> ; 'digit1-9' 'digit0-9' <*> <&:> [ sequence>number ] <@ <|> ;
: 'e' ( -- parser ) LAZY: 'e' ( -- parser )
"e" token "E" token <|> ; "e" token "E" token <|> ;
: sign-number ( { minus? num } -- number ) : sign-number ( { minus? num } -- number )
#! Convert the json number value to a factor number #! Convert the json number value to a factor number
dup second swap first [ -1 * ] when ; dup second swap first [ -1 * ] when ;
: 'exp' ( -- parser ) LAZY: 'exp' ( -- parser )
'e' 'e'
'minus' 'plus' <|> <?> &> 'minus' 'plus' <|> <?> &>
'digit0-9' <+> [ sequence>number ] <@ <&> [ sign-number ] <@ ; 'digit0-9' <+> [ sequence>number ] <@ <&> [ sign-number ] <@ ;
@ -149,19 +149,19 @@ DEFER: 'value'
#! { 1 2 3 } => 0.123 #! { 1 2 3 } => 0.123
reverse 0 [ swap 10 / + ] reduce 10 / >float ; reverse 0 [ swap 10 / + ] reduce 10 / >float ;
: 'frac' ( -- parser ) LAZY: 'frac' ( -- parser )
'decimal-point' 'digit0-9' <+> &> [ sequence>frac ] <@ ; 'decimal-point' 'digit0-9' <+> &> [ sequence>frac ] <@ ;
: raise-to-power ( { num exp } -- num ) : raise-to-power ( { num exp } -- num )
#! Multiply 'num' by 10^exp #! Multiply 'num' by 10^exp
dup second dup [ 10 swap first ^ swap first * ] [ drop first ] if ; dup second dup [ 10 swap first ^ swap first * ] [ drop first ] if ;
: 'number' ( -- parser ) LAZY: 'number' ( -- parser )
'minus' <?> 'minus' <?>
[ 'int' , 'frac' 0 succeed <|> , ] [<&>] [ sum ] <@ [ 'int' , 'frac' 0 succeed <|> , ] [<&>] [ sum ] <@
'exp' <?> <&> [ raise-to-power ] <@ <&> [ sign-number ] <@ ; 'exp' <?> <&> [ raise-to-power ] <@ <&> [ sign-number ] <@ ;
: 'value' ( -- parser ) LAZY: 'value' ( -- parser )
[ [
'false' , 'false' ,
'null' , 'null' ,
@ -174,4 +174,4 @@ DEFER: 'value'
: json> ( string -- object ) : json> ( string -- object )
#! Parse a json formatted string to a factor object #! Parse a json formatted string to a factor object
'value' some call ; 'value' some parse force ;