-
Notifications
You must be signed in to change notification settings - Fork 138
/
data_json.pir
129 lines (96 loc) · 2.67 KB
/
data_json.pir
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
# Copyright (C) 2005-2011, Parrot Foundation.
=head1 NAME
data_json - parse JSON, a lightweight data-interchange format.
=head1 SYNOPSIS
Given a valid JSON (JavaScript Object Notation) string, the compiler will
return a sub that when called will produce the appropriate values. For
example:
.local pmc json, code, result
load_language 'data_json'
json = compreg 'data_json'
code = json.'compile'('[1,2,3]')
result = code()
load_bytecode 'dumper.pbc'
_dumper( result, 'array' )
will create a PMC that C<does> C<array> containing the values 1, 2, and 3,
and store it in the C<result>.
For more information about the structure of the JSON representation, see
the documentation at L<http://www.json.org/>.
=cut
.HLL 'data_json'
.sub '__onload' :load
load_bytecode 'PGE.pbc'
load_bytecode 'PGE/Util.pbc'
load_bytecode 'TGE.pbc'
$P1 = newclass ['JSON'; 'Compiler']
$P2 = new $P1
compreg 'data_json', $P2
$P1 = new 'Hash'
$P1['\"'] = '"'
$P1['\\'] = "\\"
$P1['\/'] = '/'
$P1['\b'] = "\b"
$P1['\f'] = "\f"
$P1['\n'] = "\n"
$P1['\r'] = "\r"
$P1['\t'] = "\t"
set_root_global ['parrot'; 'data_json'], '$escapes', $P1
.end
.namespace ['JSON';'Compiler']
.sub 'compile' :method
.param string json_string
.param pmc opts :slurpy :named
.local pmc parse, match
parse = get_root_global ['parrot'; 'JSON'], 'value'
$P0 = get_root_global ['parrot'; 'PGE'], 'Match'
match = $P0.'new'(json_string)
match.'to'(0)
match = parse(match)
unless match goto failed
.local pmc pirgrammar, pirbuilder, pir
pirgrammar = new ['JSON'; 'PIR']
pirbuilder = pirgrammar.'apply'(match)
pir = pirbuilder.'get'('result')
$I0 = exists opts['target']
unless $I0 goto no_targ
$S0 = opts['target']
unless $S0 == 'pir' goto not_pir
.return (pir)
not_pir:
no_targ:
.local pmc pirc, result
pirc = compreg 'PIR'
result = pirc(pir)
.return (result)
failed:
$P0 = new 'Exception'
$P0[0] = "Invalid JSON value"
throw $P0
.end
.HLL 'parrot'
.sub unique_pmc_reg
$P0 = get_root_global ['parrot';'PGE';'Util'], 'unique'
$I0 = $P0()
$S0 = $I0
$S0 = concat "$P", $S0
.return ($S0)
.end
.sub appendln
.param pmc sb
.param string line
push sb, line
push sb, "\n"
.end
.sub 'sprintf'
.param string fmt
.param pmc args :slurpy
$S0 = sprintf fmt, args
.return ($S0)
.end
.include 'compilers/data_json/data_json/grammar.pir'
.include 'compilers/data_json/data_json/pge2pir.pir'
# Local Variables:
# mode: pir
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4 ft=pir: