Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /smlnj-lib/trunk/JSON/json-stream-parser.sml
ViewVC logotype

Annotation of /smlnj-lib/trunk/JSON/json-stream-parser.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3013 - (view) (download)

1 : jhr 2996 (* json-stream-parser.sml
2 :     *
3 :     * COPYRIGHT (c) 2008 The Fellowship of SML/NJ (http://www.smlnj.org)
4 :     * All rights reserved.
5 :     *)
6 :    
7 :     structure JSONStreamParser : sig
8 :    
9 :     (* callback functions for the different parsing events *)
10 :     type 'ctx callbacks = {
11 :     null : 'ctx -> 'ctx,
12 :     boolean : 'ctx * bool -> 'ctx,
13 :     integer : 'ctx * IntInf.int -> 'ctx,
14 :     float : 'ctx * real -> 'ctx,
15 :     string : 'ctx * string -> 'ctx,
16 :     startObject : 'ctx -> 'ctx,
17 :     objectKey : 'ctx * string -> 'ctx,
18 :     endObject : 'ctx -> 'ctx,
19 :     startArray : 'ctx -> 'ctx,
20 : jhr 3013 endArray : 'ctx -> 'ctx,
21 :     error : 'ctx * string -> 'ctx
22 : jhr 2996 }
23 :    
24 :     val parser : 'ctx callbacks -> (TextIO.instream * 'ctx) -> unit
25 :    
26 :     end = struct
27 :    
28 : jhr 3004 structure Lex = JSONLexer
29 :     structure T = JSONTokens
30 :    
31 : jhr 2996 (* callback functions for the different parsing events *)
32 :     type 'ctx callbacks = {
33 :     null : 'ctx -> 'ctx,
34 :     boolean : 'ctx * bool -> 'ctx,
35 :     integer : 'ctx * IntInf.int -> 'ctx,
36 :     float : 'ctx * real -> 'ctx,
37 :     string : 'ctx * string -> 'ctx,
38 :     startObject : 'ctx -> 'ctx,
39 :     objectKey : 'ctx * string -> 'ctx,
40 :     endObject : 'ctx -> 'ctx,
41 :     startArray : 'ctx -> 'ctx,
42 : jhr 3013 endArray : 'ctx -> 'ctx,
43 :     error : 'ctx * string -> 'ctx
44 : jhr 2996 }
45 :    
46 : jhr 3013 fun error (cb : 'a callbacks, ctx, msg) = (
47 :     #error cb (ctx, msg);
48 :     raise Fail "error")
49 :    
50 :     fun parser (cb : 'a callbacks) (inStrm, ctx) = let
51 :     val lexer = Lex.lex (AntlrStreamPos.mkSourcemap ())
52 :     fun parseValue (strm : Lex.strm, ctx) = let
53 : jhr 3004 val (tok, pos, strm) = lexer strm
54 :     in
55 :     case tok
56 : jhr 3013 of T.LB => parseArray (strm, ctx)
57 :     | T.LCB => parseObject (strm, ctx)
58 : jhr 3004 | T.KW_null => (strm, #null cb ctx)
59 :     | T.KW_true => (strm, #boolean cb (ctx, true))
60 :     | T.KW_false => (strm, #boolean cb (ctx, false))
61 :     | T.INT n => (strm, #integer cb (ctx, n))
62 :     | T.FLOAT f => (strm, #float cb (ctx, f))
63 :     | T.STRING s => (strm, #string cb (ctx, s))
64 : jhr 3013 | _ => error (cb, ctx, "error parsing value")
65 : jhr 3004 (* end case *)
66 :     end
67 : jhr 3013 and parseArray (strm : Lex.strm, ctx) = (case lexer strm
68 :     of (T.RB, _, strm) => (strm, #endArray cb (#startArray cb ctx))
69 :     | _ => let
70 :     fun loop (strm, ctx) = let
71 :     val (strm, ctx) = parseValue (strm, ctx)
72 :     (* expect either a "," or a "]" *)
73 :     val (tok, pos, strm) = lexer strm
74 :     in
75 :     case tok
76 :     of T.RB => (strm, ctx)
77 :     | T.COMMA => loop (strm, ctx)
78 :     | _ => error (cb, ctx, "error parsing array")
79 :     (* end case *)
80 :     end
81 :     val ctx = #startArray cb ctx
82 :     val (strm, ctx) = loop (strm, #startArray cb ctx)
83 : jhr 3004 in
84 : jhr 3013 (strm, #endArray cb ctx)
85 : jhr 3004 end
86 : jhr 3013 (* end case *))
87 :     and parseObject (strm : Lex.strm, ctx) = let
88 :     fun parseField (strm, ctx) = (case lexer strm
89 :     of (T.STRING s, pos, strm) => let
90 :     val ctx = #objectKey cb (ctx, s)
91 :     in
92 :     case lexer strm
93 :     of (T.COLON, _, strm) => parseValue (strm, ctx)
94 :     | _ => error (cb, ctx, "error parsing field")
95 :     (* end case *)
96 :     end
97 :     | _ => (strm, ctx)
98 :     (* end case *))
99 : jhr 3004 fun loop (strm, ctx) = let
100 : jhr 3013 val (strm, ctx) = parseField (strm, ctx)
101 : jhr 3004 in
102 : jhr 3013 (* expect either "," or "}" *)
103 :     case lexer strm
104 :     of (T.RCB, pos, strm) => (strm, ctx)
105 :     | (T.COMMA, pos, strm) => loop (strm, ctx)
106 :     | _ => error (cb, ctx, "error parsing object")
107 : jhr 3004 (* end case *)
108 :     end
109 : jhr 3013 val ctx = #startObject cb ctx
110 : jhr 3004 val (strm, ctx) = loop (strm, #startObject cb ctx)
111 :     in
112 : jhr 3013 (strm, #endObject cb ctx)
113 : jhr 3004 end
114 :     in
115 : jhr 3013 ignore (parseValue (Lex.streamifyInstream inStrm, ctx))
116 : jhr 3004 end
117 : jhr 2996
118 :     end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0