Home | History | Annotate | Download | only in Chapter4 
      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
    123