Mercurial > hg > Members > tobaru > cbc > CbC_llvm

comparison examples/OCaml-Kaleidoscope/Chapter4/parser.ml @ 0:95c75e76d11b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
LLVM 3.4
author Kaito Tokumori <e105711@ie.u-ryukyu.ac.jp>
date Thu, 12 Dec 2013 13:56:28 +0900
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:95c75e76d11b
1 (*===---------------------------------------------------------------------===
2 * Parser
3 *===---------------------------------------------------------------------===*)
4
5 (* binop_precedence - This holds the precedence for each binary operator that is
6 * defined *)
7 let binop_precedence:(char, int) Hashtbl.t = Hashtbl.create 10
8
9 (* precedence - Get the precedence of the pending binary operator token. *)
10 let precedence c = try Hashtbl.find binop_precedence c with Not_found -> -1
11
12 (* primary
13 * ::= identifier
14 * ::= numberexpr
15 * ::= parenexpr *)
16 let rec parse_primary = parser
17 (* numberexpr ::= number *)
18 | [< 'Token.Number n >] -> Ast.Number n
19
20 (* parenexpr ::= '(' expression ')' *)
21 | [< 'Token.Kwd '('; e=parse_expr; 'Token.Kwd ')' ?? "expected ')'" >] -> e
22
23 (* identifierexpr
24 * ::= identifier
25 * ::= identifier '(' argumentexpr ')' *)
26 | [< 'Token.Ident id; stream >] ->
27 let rec parse_args accumulator = parser
28 | [< e=parse_expr; stream >] ->
29 begin parser
30 | [< 'Token.Kwd ','; e=parse_args (e :: accumulator) >] -> e
31 | [< >] -> e :: accumulator
32 end stream
33 | [< >] -> accumulator
34 in
35 let rec parse_ident id = parser
36 (* Call. *)
37 | [< 'Token.Kwd '(';
38 args=parse_args [];
39 'Token.Kwd ')' ?? "expected ')'">] ->
40 Ast.Call (id, Array.of_list (List.rev args))
41
42 (* Simple variable ref. *)
43 | [< >] -> Ast.Variable id
44 in
45 parse_ident id stream
46
47 | [< >] -> raise (Stream.Error "unknown token when expecting an expression.")
48
49 (* binoprhs
50 * ::= ('+' primary)* *)
51 and parse_bin_rhs expr_prec lhs stream =
52 match Stream.peek stream with
53 (* If this is a binop, find its precedence. *)
54 | Some (Token.Kwd c) when Hashtbl.mem binop_precedence c ->
55 let token_prec = precedence c in
56
57 (* If this is a binop that binds at least as tightly as the current binop,
58 * consume it, otherwise we are done. *)
59 if token_prec < expr_prec then lhs else begin
60 (* Eat the binop. *)
61 Stream.junk stream;
62
63 (* Parse the primary expression after the binary operator. *)
64 let rhs = parse_primary stream in
65
66 (* Okay, we know this is a binop. *)
67 let rhs =
68 match Stream.peek stream with
69 | Some (Token.Kwd c2) ->
70 (* If BinOp binds less tightly with rhs than the operator after
71 * rhs, let the pending operator take rhs as its lhs. *)
72 let next_prec = precedence c2 in
73 if token_prec < next_prec
74 then parse_bin_rhs (token_prec + 1) rhs stream
75 else rhs
76 | _ -> rhs
77 in
78
79 (* Merge lhs/rhs. *)
80 let lhs = Ast.Binary (c, lhs, rhs) in
81 parse_bin_rhs expr_prec lhs stream
82 end
83 | _ -> lhs
84
85 (* expression
86 * ::= primary binoprhs *)
87 and parse_expr = parser
88 | [< lhs=parse_primary; stream >] -> parse_bin_rhs 0 lhs stream
89
90 (* prototype
91 * ::= id '(' id* ')' *)
92 let parse_prototype =
93 let rec parse_args accumulator = parser
94 | [< 'Token.Ident id; e=parse_args (id::accumulator) >] -> e
95 | [< >] -> accumulator
96 in
97
98 parser
99 | [< 'Token.Ident id;
100 'Token.Kwd '(' ?? "expected '(' in prototype";
101 args=parse_args [];
102 'Token.Kwd ')' ?? "expected ')' in prototype" >] ->
103 (* success. *)
104 Ast.Prototype (id, Array.of_list (List.rev args))
105
106 | [< >] ->
107 raise (Stream.Error "expected function name in prototype")
108
109 (* definition ::= 'def' prototype expression *)
110 let parse_definition = parser
111 | [< 'Token.Def; p=parse_prototype; e=parse_expr >] ->
112 Ast.Function (p, e)
113
114 (* toplevelexpr ::= expression *)
115 let parse_toplevel = parser
116 | [< e=parse_expr >] ->
117 (* Make an anonymous proto. *)
118 Ast.Function (Ast.Prototype ("", [||]), e)
119
120 (* external ::= 'extern' prototype *)
121 let parse_extern = parser
122 | [< 'Token.Extern; e=parse_prototype >] -> e