← Back to branch summary

~pali/+junk/llvm-toolchain-3.7

« back to all changes in this revision

Viewing changes to examples/OCaml-Kaleidoscope/Chapter5/parser.ml

  • Committer: Package Import Robot
  • Author(s): Sylvestre Ledru
  • Date: 2015-07-15 17:51:08 UTC
  • Revision ID: package-import@ubuntu.com-20150715175108-l8mynwovkx4zx697
Tags: upstream-3.7~+rc2
Import upstream version 3.7~+rc2

Show diffs side-by-side

added added

removed removed

Lines of Context:
examples/OCaml-Kaleidoscope/Chapter5/parser.ml
 
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
 *   ::= ifexpr
 
17
 *   ::= forexpr *)
 
18
let rec parse_primary = parser
 
19
  (* numberexpr ::= number *)
 
20
  | [< 'Token.Number n >] -> Ast.Number n
 
21
 
 
22
  (* parenexpr ::= '(' expression ')' *)
 
23
  | [< 'Token.Kwd '('; e=parse_expr; 'Token.Kwd ')' ?? "expected ')'" >] -> e
 
24
 
 
25
  (* identifierexpr
 
26
   *   ::= identifier
 
27
   *   ::= identifier '(' argumentexpr ')' *)
 
28
  | [< 'Token.Ident id; stream >] ->
 
29
      let rec parse_args accumulator = parser
 
30
        | [< e=parse_expr; stream >] ->
 
31
            begin parser
 
32
              | [< 'Token.Kwd ','; e=parse_args (e :: accumulator) >] -> e
 
33
              | [< >] -> e :: accumulator
 
34
            end stream
 
35
        | [< >] -> accumulator
 
36
      in
 
37
      let rec parse_ident id = parser
 
38
        (* Call. *)
 
39
        | [< 'Token.Kwd '(';
 
40
             args=parse_args [];
 
41
             'Token.Kwd ')' ?? "expected ')'">] ->
 
42
            Ast.Call (id, Array.of_list (List.rev args))
 
43
 
 
44
        (* Simple variable ref. *)
 
45
        | [< >] -> Ast.Variable id
 
46
      in
 
47
      parse_ident id stream
 
48
 
 
49
  (* ifexpr ::= 'if' expr 'then' expr 'else' expr *)
 
50
  | [< 'Token.If; c=parse_expr;
 
51
       'Token.Then ?? "expected 'then'"; t=parse_expr;
 
52
       'Token.Else ?? "expected 'else'"; e=parse_expr >] ->
 
53
      Ast.If (c, t, e)
 
54
 
 
55
  (* forexpr
 
56
        ::= 'for' identifier '=' expr ',' expr (',' expr)? 'in' expression *)
 
57
  | [< 'Token.For;
 
58
       'Token.Ident id ?? "expected identifier after for";
 
59
       'Token.Kwd '=' ?? "expected '=' after for";
 
60
       stream >] ->
 
61
      begin parser
 
62
        | [<
 
63
             start=parse_expr;
 
64
             'Token.Kwd ',' ?? "expected ',' after for";
 
65
             end_=parse_expr;
 
66
             stream >] ->
 
67
            let step =
 
68
              begin parser
 
69
              | [< 'Token.Kwd ','; step=parse_expr >] -> Some step
 
70
              | [< >] -> None
 
71
              end stream
 
72
            in
 
73
            begin parser
 
74
            | [< 'Token.In; body=parse_expr >] ->
 
75
                Ast.For (id, start, end_, step, body)
 
76
            | [< >] ->
 
77
                raise (Stream.Error "expected 'in' after for")
 
78
            end stream
 
79
        | [< >] ->
 
80
            raise (Stream.Error "expected '=' after for")
 
81
      end stream
 
82
 
 
83
  | [< >] -> raise (Stream.Error "unknown token when expecting an expression.")
 
84
 
 
85
(* binoprhs
 
86
 *   ::= ('+' primary)* *)
 
87
and parse_bin_rhs expr_prec lhs stream =
 
88
  match Stream.peek stream with
 
89
  (* If this is a binop, find its precedence. *)
 
90
  | Some (Token.Kwd c) when Hashtbl.mem binop_precedence c ->
 
91
      let token_prec = precedence c in
 
92
 
 
93
      (* If this is a binop that binds at least as tightly as the current binop,
 
94
       * consume it, otherwise we are done. *)
 
95
      if token_prec < expr_prec then lhs else begin
 
96
        (* Eat the binop. *)
 
97
        Stream.junk stream;
 
98
 
 
99
        (* Parse the primary expression after the binary operator. *)
 
100
        let rhs = parse_primary stream in
 
101
 
 
102
        (* Okay, we know this is a binop. *)
 
103
        let rhs =
 
104
          match Stream.peek stream with
 
105
          | Some (Token.Kwd c2) ->
 
106
              (* If BinOp binds less tightly with rhs than the operator after
 
107
               * rhs, let the pending operator take rhs as its lhs. *)
 
108
              let next_prec = precedence c2 in
 
109
              if token_prec < next_prec
 
110
              then parse_bin_rhs (token_prec + 1) rhs stream
 
111
              else rhs
 
112
          | _ -> rhs
 
113
        in
 
114
 
 
115
        (* Merge lhs/rhs. *)
 
116
        let lhs = Ast.Binary (c, lhs, rhs) in
 
117
        parse_bin_rhs expr_prec lhs stream
 
118
      end
 
119
  | _ -> lhs
 
120
 
 
121
(* expression
 
122
 *   ::= primary binoprhs *)
 
123
and parse_expr = parser
 
124
  | [< lhs=parse_primary; stream >] -> parse_bin_rhs 0 lhs stream
 
125
 
 
126
(* prototype
 
127
 *   ::= id '(' id* ')' *)
 
128
let parse_prototype =
 
129
  let rec parse_args accumulator = parser
 
130
    | [< 'Token.Ident id; e=parse_args (id::accumulator) >] -> e
 
131
    | [< >] -> accumulator
 
132
  in
 
133
 
 
134
  parser
 
135
  | [< 'Token.Ident id;
 
136
       'Token.Kwd '(' ?? "expected '(' in prototype";
 
137
       args=parse_args [];
 
138
       'Token.Kwd ')' ?? "expected ')' in prototype" >] ->
 
139
      (* success. *)
 
140
      Ast.Prototype (id, Array.of_list (List.rev args))
 
141
 
 
142
  | [< >] ->
 
143
      raise (Stream.Error "expected function name in prototype")
 
144
 
 
145
(* definition ::= 'def' prototype expression *)
 
146
let parse_definition = parser
 
147
  | [< 'Token.Def; p=parse_prototype; e=parse_expr >] ->
 
148
      Ast.Function (p, e)
 
149
 
 
150
(* toplevelexpr ::= expression *)
 
151
let parse_toplevel = parser
 
152
  | [< e=parse_expr >] ->
 
153
      (* Make an anonymous proto. *)
 
154
      Ast.Function (Ast.Prototype ("", [||]), e)
 
155
 
 
156
(*  external ::= 'extern' prototype *)
 
157
let parse_extern = parser
 
158
  | [< 'Token.Extern; e=parse_prototype >] -> e