17abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao(*===---------------------------------------------------------------------=== 27abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao * Parser 37abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao *===---------------------------------------------------------------------===*) 47abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 57abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao(* binop_precedence - This holds the precedence for each binary operator that is 67abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao * defined *) 77abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liaolet binop_precedence:(char, int) Hashtbl.t = Hashtbl.create 10 87abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 97abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao(* precedence - Get the precedence of the pending binary operator token. *) 107abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liaolet precedence c = try Hashtbl.find binop_precedence c with Not_found -> -1 117abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 127abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao(* primary 137abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao * ::= identifier 147abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao * ::= numberexpr 157abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao * ::= parenexpr *) 167abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liaolet rec parse_primary = parser 177abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* numberexpr ::= number *) 187abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< 'Token.Number n >] -> Ast.Number n 197abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 207abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* parenexpr ::= '(' expression ')' *) 217abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< 'Token.Kwd '('; e=parse_expr; 'Token.Kwd ')' ?? "expected ')'" >] -> e 227abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 237abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* identifierexpr 247abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao * ::= identifier 257abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao * ::= identifier '(' argumentexpr ')' *) 267abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< 'Token.Ident id; stream >] -> 277abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao let rec parse_args accumulator = parser 287abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< e=parse_expr; stream >] -> 297abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao begin parser 307abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< 'Token.Kwd ','; e=parse_args (e :: accumulator) >] -> e 317abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< >] -> e :: accumulator 327abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao end stream 337abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< >] -> accumulator 347abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao in 357abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao let rec parse_ident id = parser 367abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* Call. *) 377abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< 'Token.Kwd '('; 387abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao args=parse_args []; 397abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 'Token.Kwd ')' ?? "expected ')'">] -> 407abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao Ast.Call (id, Array.of_list (List.rev args)) 417abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 427abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* Simple variable ref. *) 437abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< >] -> Ast.Variable id 447abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao in 457abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao parse_ident id stream 467abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 477abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< >] -> raise (Stream.Error "unknown token when expecting an expression.") 487abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 497abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao(* binoprhs 507abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao * ::= ('+' primary)* *) 517abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liaoand parse_bin_rhs expr_prec lhs stream = 527abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao match Stream.peek stream with 537abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* If this is a binop, find its precedence. *) 547abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | Some (Token.Kwd c) when Hashtbl.mem binop_precedence c -> 557abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao let token_prec = precedence c in 567abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 577abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* If this is a binop that binds at least as tightly as the current binop, 587abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao * consume it, otherwise we are done. *) 597abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao if token_prec < expr_prec then lhs else begin 607abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* Eat the binop. *) 617abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao Stream.junk stream; 627abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 637abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* Parse the primary expression after the binary operator. *) 647abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao let rhs = parse_primary stream in 657abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 667abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* Okay, we know this is a binop. *) 677abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao let rhs = 687abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao match Stream.peek stream with 697abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | Some (Token.Kwd c2) -> 707abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* If BinOp binds less tightly with rhs than the operator after 717abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao * rhs, let the pending operator take rhs as its lhs. *) 727abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao let next_prec = precedence c2 in 737abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao if token_prec < next_prec 747abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao then parse_bin_rhs (token_prec + 1) rhs stream 757abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao else rhs 767abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | _ -> rhs 777abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao in 787abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 797abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* Merge lhs/rhs. *) 807abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao let lhs = Ast.Binary (c, lhs, rhs) in 817abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao parse_bin_rhs expr_prec lhs stream 827abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao end 837abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | _ -> lhs 847abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 857abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao(* expression 867abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao * ::= primary binoprhs *) 877abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liaoand parse_expr = parser 887abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< lhs=parse_primary; stream >] -> parse_bin_rhs 0 lhs stream 897abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 907abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao(* prototype 917abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao * ::= id '(' id* ')' *) 927abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liaolet parse_prototype = 937abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao let rec parse_args accumulator = parser 947abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< 'Token.Ident id; e=parse_args (id::accumulator) >] -> e 957abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< >] -> accumulator 967abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao in 977abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 987abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao parser 997abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< 'Token.Ident id; 1007abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 'Token.Kwd '(' ?? "expected '(' in prototype"; 1017abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao args=parse_args []; 1027abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 'Token.Kwd ')' ?? "expected ')' in prototype" >] -> 1037abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* success. *) 1047abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao Ast.Prototype (id, Array.of_list (List.rev args)) 1057abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 1067abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< >] -> 1077abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao raise (Stream.Error "expected function name in prototype") 1087abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 1097abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao(* definition ::= 'def' prototype expression *) 1107abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liaolet parse_definition = parser 1117abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< 'Token.Def; p=parse_prototype; e=parse_expr >] -> 1127abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao Ast.Function (p, e) 1137abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 1147abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao(* toplevelexpr ::= expression *) 1157abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liaolet parse_toplevel = parser 1167abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< e=parse_expr >] -> 1177abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* Make an anonymous proto. *) 1187abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao Ast.Function (Ast.Prototype ("", [||]), e) 1197abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 1207abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao(* external ::= 'extern' prototype *) 1217abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liaolet parse_extern = parser 1227abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< 'Token.Extern; e=parse_prototype >] -> e 123