Author: coke
Date: Fri Oct 21 08:48:09 2005
New Revision: 9529
Added:
trunk/runtime/parrot/library/JSON.imc
trunk/t/library/json.t
Modified:
trunk/MANIFEST
trunk/config/gen/makefiles/root.in
Log:
11:56 <Coke> JSON?
11:56 <purl> well, JSON is Javascript Object Notation, at
http://www.crockford.com/JSON/
Here is a first pass at adding JSON to the library.
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST (original)
+++ trunk/MANIFEST Fri Oct 21 08:48:09 2005
@@ -1630,6 +1630,7 @@ lib/Test/Builder.pm
lib/Test/More.pm [devel]
lib/Test/Simple.pm [devel]
lib/Text/Balanced.pm [devel]
+runtime/parrot/library/JSON.imc [library]
runtime/parrot/library/Data/Sort.imc [library]
runtime/parrot/library/Data/Escape.imc [library]
runtime/parrot/library/Data/Replace.imc [library]
@@ -1928,6 +1929,7 @@ t/pmc/tqueue.t
t/pmc/undef.t []
t/library/data_escape.t []
t/library/dumper.t []
+t/library/json.t []
t/library/getopt_long.t []
t/library/md5.t []
t/library/parrotlib.t []
Modified: trunk/config/gen/makefiles/root.in
==============================================================================
--- trunk/config/gen/makefiles/root.in (original)
+++ trunk/config/gen/makefiles/root.in Fri Oct 21 08:48:09 2005
@@ -250,6 +250,7 @@ GEN_LIBRARY = \
$(LIBRARY_DIR)/Digest/MD5.pbc \
$(LIBRARY_DIR)/dumper.pbc \
$(LIBRARY_DIR)/Getopt/Long.pbc \
+ $(LIBRARY_DIR)/JSON.pbc \
$(LIBRARY_DIR)/ncurses.pbc \
$(LIBRARY_DIR)/parrotlib.pbc \
$(LIBRARY_DIR)/pcre.pbc \
Added: trunk/runtime/parrot/library/JSON.imc
==============================================================================
--- (empty file)
+++ trunk/runtime/parrot/library/JSON.imc Fri Oct 21 08:48:09 2005
@@ -0,0 +1,332 @@
+=head1 TITLE
+
+JSON.imc - PIR implementation of JSON data interchange format.
+
+=head1 SYNOPSIS
+
+ ...
+
+ # generate a JSON representation of a PMC.
+ $S0 = _json( $P0 )
+
+ # generate a PMC from a JSON representation:
+ $P1 = _json_to_pmc( "[1,2,3]" )
+ #$P1 is now a array-like container PMC with three Integer elements.
+
+ .end
+ .include 'library/JSON.imc'
+
+=head1 DESCRIPTION
+
+PIR implementation of JSON
+
+=cut
+
+=head1 FUNCTIONS
+
+This library provides the following functions:
+
+=over 4
+
+=item (string) = _json(pmc, ?pretty] )
+
+Convert a PMC to a JSON-serialized string
+
+=over 4
+
+=item pmc
+
+Required. The PMC to dump.
+
+=item pretty
+
+Optional. Boolean: If true, then the generated string will be very
+readable for humans. Defaults to false, which will generate the
+most compact string possible.
+
+=back
+
+=cut
+
+.const string _json_prefix = ' '
+
+.sub _json
+ .param pmc thing
+ .param int pretty :optional
+ .param int has_pretty :opt_flag
+
+ .local string result
+
+ if has_pretty goto done_init
+ pretty = 0
+
+done_init:
+ result = _json_any(thing,pretty,0)
+ unless pretty goto plain
+ result .= "\n"
+plain:
+ .return (result)
+.end
+
+.sub _json_any
+ .param pmc thing
+ .param int pretty
+ .param int indent
+
+done_init:
+ if_null thing, json_null
+
+ $I0 = does thing, "array"
+ if $I0 goto json_array
+
+ $I0 = does thing, "hash"
+ if $I0 goto json_hash
+
+ $I0 = does thing, "string"
+ if $I0 goto json_string
+
+ $I0 = does thing, "boolean"
+ if $I0 goto json_boolean
+
+ $I0 = does thing, "integer"
+ if $I0 goto json_integer
+
+ $I0 = does thing, "float"
+ if $I0 goto json_float
+
+ # Default to a null. We could in the future make this more
+ # clever, or conditional.
+json_null:
+ .return _json_null(thing,pretty,indent)
+json_string:
+ .return _json_string(thing,pretty,indent)
+json_array:
+ .return _json_array(thing,pretty,indent)
+json_hash:
+ .return _json_hash(thing,pretty,indent)
+json_boolean:
+ .return _json_boolean(thing,pretty,indent)
+json_integer:
+ .return _json_number(thing,pretty,indent)
+json_float:
+ .return _json_number(thing,pretty,indent)
+
+.end
+
+.sub '_json_null'
+ .param pmc thing # ignored, but needed for the ``API''
+ .param int pretty
+ .param int indent
+
+ unless pretty goto plain
+ unless indent goto plain
+
+ .local string result
+ result = repeat _json_prefix, indent
+ result .= 'null'
+ .return (result)
+
+plain:
+ .return ('null')
+.end
+
+.sub '_json_string'
+ .param pmc thing
+ .param int pretty
+ .param int indent
+
+ .local string result
+
+ $S0 = thing
+ result = '"' . $S0
+ result = result . '"'
+
+ unless pretty goto plain
+ unless indent goto plain
+
+ $S0 = repeat _json_prefix, indent
+ result = $S0 . result
+
+plain:
+ .return (result)
+.end
+
+.sub '_json_boolean'
+ .param pmc thing
+ .param int pretty
+ .param int indent
+
+ .local string result
+
+ result = 'true'
+ if thing goto got_value
+ result = 'false'
+
+got_value:
+
+ unless pretty goto plain
+ unless indent goto plain
+
+ $S0 = repeat _json_prefix, indent
+ result = $S0 . result
+
+plain:
+ .return (result)
+.end
+
+.sub '_json_number'
+ .param pmc thing
+ .param int pretty
+ .param int indent
+
+ .local string result
+
+ result = thing
+
+ unless pretty goto plain
+ unless indent goto plain
+
+ $S0 = repeat _json_prefix, indent
+ result = $S0 . result
+
+plain:
+ .return (result)
+.end
+
+.sub '_json_array'
+ .param pmc thing
+ .param int pretty
+ .param int indent
+
+ .local string result
+
+ result = '['
+
+ unless pretty goto pre_loop
+ unless indent goto pre_loop
+
+ $S0 = repeat _json_prefix, indent
+ result = $S0 . result
+ result .= "\n"
+
+pre_loop:
+ inc indent
+ .local int pos,len
+ pos = 0
+ len = thing
+ unless pretty goto loop
+ result .= "\n"
+
+loop:
+ if pos >= len goto done_loop
+ $P1 = thing[pos]
+ $S0 = _json_any($P1,pretty,indent)
+ result .= $S0
+ inc pos
+ if pos == len goto loop
+ result .= ","
+ unless pretty goto loop
+ result .= "\n"
+ goto loop
+
+done_loop:
+ dec indent
+
+ .local string optional_newline,optional_indent
+ optional_newline = ''
+ optional_indent = ''
+
+ unless pretty goto done
+ optional_newline = "\n"
+
+ unless indent goto done
+ optional_indent = repeat _json_prefix, indent
+
+done:
+ result .= optional_newline
+ result .= optional_indent
+ result .= ']'
+
+ .return (result)
+.end
+
+.sub '_json_hash'
+ .param pmc thing
+ .param int pretty
+ .param int indent
+
+ .local string result,separator
+
+ result = '{'
+ separator = ':'
+
+ unless pretty goto pre_loop
+ separator = ' : '
+ unless indent goto pre_loop
+
+ $S0 = repeat _json_prefix, indent
+ result = $S0 . result
+ result .= "\n"
+
+pre_loop:
+ inc indent
+ .local int pos,len
+ pos = 0
+ len = thing
+ unless pretty goto loop
+ result .= "\n"
+ .local pmc iter
+ iter = new .Iterator, thing
+ iter = 0
+ .local string key
+
+loop:
+ if pos >= len goto done_loop
+ key = shift iter
+ $S0 = _json_string(key,pretty,indent)
+ result .= $S0
+ result .= separator
+ $P1 = thing[key]
+ $S0 = _json_any($P1,pretty,indent)
+ result .= $S0
+ inc pos
+ if pos == len goto loop
+ result .= ","
+ unless pretty goto loop
+ result .= "\n"
+ goto loop
+
+done_loop:
+ dec indent
+
+ .local string optional_newline,optional_indent
+ optional_newline = ''
+ optional_indent = ''
+
+ unless pretty goto done
+ optional_newline = "\n"
+
+ unless indent goto done
+ optional_indent = repeat _json_prefix, indent
+
+done:
+ result .= optional_newline
+ result .= optional_indent
+ result .= '}'
+
+ .return (result)
+.end
+
+=head1 TODO
+
+=over 4
+
+=item Hashed subentries are not entirely pretty yet.
+
+=item Pending a more comprehensive test suite from Roger Browne
+
+=item String Escaping
+
+=item implement _jsan_to_pmc
+
+=cut
Added: trunk/t/library/json.t
==============================================================================
--- (empty file)
+++ trunk/t/library/json.t Fri Oct 21 08:48:09 2005
@@ -0,0 +1,77 @@
+#! perl -w
+# Copyright: 2001-2005 The Perl Foundation. All Rights Reserved.
+# $Id $
+
+=head1 NAME
+
+t/library/json.t - test JSON library
+
+=head1 SYNOPSIS
+
+ % perl -Ilib t/library/json.t
+
+=head1 DESCRIPTION
+
+Tests JSON->Parrot and Parrot->JSON conversions.
+
+=cut
+
+use strict;
+
+use Parrot::Test tests => 2;
+use Test::More;
+
+use vars qw($SKIP);
+
+SKIP: {
+ local $SKIP = "Not implemented yet.";
+
+# no. 1
+pir_output_is(<<'CODE', <<'OUT', 'Create JSON of an empty string');
+
+.sub test :main
+ $S0 =_json( '', 1 )
+ print $S0
+.end
+.include 'library/JSON.imc'
+CODE
+""
+OUT
+
+# no. 2
+pir_output_is(<<'CODE', <<'OUT', 'Create JSON of an array');
+
+.sub test :main
+ .local pmc array
+
+ new array, .PerlArray
+ push array, 0
+ push array, 1
+ push array, 2
+ push array, 3
+ push array, 4
+ push array, 5
+ push array, 6
+ push array, 7
+ push array, 8
+ push array, 9
+
+ $S0 = _json( array, 1 )
+ print $S0
+.end
+.include 'library/JSON.imc'
+CODE
+[
+ 0,
+ 1,
+ 2,
+ 3,
+ 4,
+ 5,
+ 6,
+ 7,
+ 8,
+ 9
+]
+OUT
+}
