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 3590 - (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 : jhr 3590 val parse : 'ctx callbacks -> (TextIO.instream * 'ctx) -> 'ctx
25 : jhr 2996
26 : jhr 3590 val parseFile : 'ctx callbacks -> (string * 'ctx) -> 'ctx
27 :    
28 : jhr 2996 end = struct
29 :    
30 : jhr 3004 structure Lex = JSONLexer
31 :     structure T = JSONTokens
32 :    
33 : jhr 2996 (* callback functions for the different parsing events *)
34 :     type 'ctx callbacks = {
35 :     null : 'ctx -> 'ctx,
36 :     boolean : 'ctx * bool -> 'ctx,
37 :     integer : 'ctx * IntInf.int -> 'ctx,
38 :     float : 'ctx * real -> 'ctx,
39 :     string : 'ctx * string -> 'ctx,
40 :     startObject : 'ctx -> 'ctx,
41 :     objectKey : 'ctx * string -> 'ctx,
42 :     endObject : 'ctx -> 'ctx,
43 :     startArray : 'ctx -> 'ctx,
44 : jhr 3013 endArray : 'ctx -> 'ctx,
45 :     error : 'ctx * string -> 'ctx
46 : jhr 2996 }
47 :    
48 : jhr 3013 fun error (cb : 'a callbacks, ctx, msg) = (
49 :     #error cb (ctx, msg);
50 :     raise Fail "error")
51 :    
52 : jhr 3590 fun parser (cb : 'a callbacks) (srcMap, inStrm, ctx) = let
53 : jhr 3013 val lexer = Lex.lex (AntlrStreamPos.mkSourcemap ())
54 :     fun parseValue (strm : Lex.strm, ctx) = let
55 : jhr 3004 val (tok, pos, strm) = lexer strm
56 :     in
57 :     case tok
58 : jhr 3013 of T.LB => parseArray (strm, ctx)
59 :     | T.LCB => parseObject (strm, ctx)
60 : jhr 3004 | T.KW_null => (strm, #null cb ctx)
61 :     | T.KW_true => (strm, #boolean cb (ctx, true))
62 :     | T.KW_false => (strm, #boolean cb (ctx, false))
63 :     | T.INT n => (strm, #integer cb (ctx, n))
64 :     | T.FLOAT f => (strm, #float cb (ctx, f))
65 :     | T.STRING s => (strm, #string cb (ctx, s))
66 : jhr 3013 | _ => error (cb, ctx, "error parsing value")
67 : jhr 3004 (* end case *)
68 :     end
69 : jhr 3013 and parseArray (strm : Lex.strm, ctx) = (case lexer strm
70 :     of (T.RB, _, strm) => (strm, #endArray cb (#startArray cb ctx))
71 :     | _ => let
72 :     fun loop (strm, ctx) = let
73 :     val (strm, ctx) = parseValue (strm, ctx)
74 :     (* expect either a "," or a "]" *)
75 :     val (tok, pos, strm) = lexer strm
76 :     in
77 :     case tok
78 :     of T.RB => (strm, ctx)
79 :     | T.COMMA => loop (strm, ctx)
80 :     | _ => error (cb, ctx, "error parsing array")
81 :     (* end case *)
82 :     end
83 :     val ctx = #startArray cb ctx
84 :     val (strm, ctx) = loop (strm, #startArray cb ctx)
85 : jhr 3004 in
86 : jhr 3013 (strm, #endArray cb ctx)
87 : jhr 3004 end
88 : jhr 3013 (* end case *))
89 :     and parseObject (strm : Lex.strm, ctx) = let
90 :     fun parseField (strm, ctx) = (case lexer strm
91 :     of (T.STRING s, pos, strm) => let
92 :     val ctx = #objectKey cb (ctx, s)
93 :     in
94 :     case lexer strm
95 :     of (T.COLON, _, strm) => parseValue (strm, ctx)
96 :     | _ => error (cb, ctx, "error parsing field")
97 :     (* end case *)
98 :     end
99 :     | _ => (strm, ctx)
100 :     (* end case *))
101 : jhr 3004 fun loop (strm, ctx) = let
102 : jhr 3013 val (strm, ctx) = parseField (strm, ctx)
103 : jhr 3004 in
104 : jhr 3013 (* expect either "," or "}" *)
105 :     case lexer strm
106 :     of (T.RCB, pos, strm) => (strm, ctx)
107 :     | (T.COMMA, pos, strm) => loop (strm, ctx)
108 :     | _ => error (cb, ctx, "error parsing object")
109 : jhr 3004 (* end case *)
110 :     end
111 : jhr 3013 val ctx = #startObject cb ctx
112 : jhr 3004 val (strm, ctx) = loop (strm, #startObject cb ctx)
113 :     in
114 : jhr 3013 (strm, #endObject cb ctx)
115 : jhr 3004 end
116 :     in
117 : jhr 3590 #2 (parseValue (Lex.streamifyInstream inStrm, ctx))
118 : jhr 3004 end
119 : jhr 2996
120 : jhr 3590 fun parse cb = let
121 :     val parser = parser cb
122 :     fun parse' (inStrm, ctx) =
123 :     parser(AntlrStreamPos.mkSourcemap (), inStrm, ctx)
124 :     in
125 :     parse'
126 :     end
127 :    
128 :     fun parseFile cb = let
129 :     val parser = parser cb
130 :     fun parse (fileName, ctx) = let
131 :     val inStrm = TextIO.openIn fileName
132 :     val ctx = parser (AntlrStreamPos.mkSourcemap' fileName, inStrm, ctx)
133 :     handle ex => (TextIO.closeIn inStrm; raise ex)
134 :     in
135 :     TextIO.closeIn inStrm;
136 :     ctx
137 :     end
138 :     in
139 :     parse
140 :     end
141 :    
142 : jhr 2996 end

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