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 Liao * ::= ifexpr 177abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao * ::= forexpr *) 187abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liaolet rec parse_primary = parser 197abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* numberexpr ::= number *) 207abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< 'Token.Number n >] -> Ast.Number n 217abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 227abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* parenexpr ::= '(' expression ')' *) 237abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< 'Token.Kwd '('; e=parse_expr; 'Token.Kwd ')' ?? "expected ')'" >] -> e 247abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 257abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* identifierexpr 267abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao * ::= identifier 277abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao * ::= identifier '(' argumentexpr ')' *) 287abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< 'Token.Ident id; stream >] -> 297abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao let rec parse_args accumulator = parser 307abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< e=parse_expr; stream >] -> 317abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao begin parser 327abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< 'Token.Kwd ','; e=parse_args (e :: accumulator) >] -> e 337abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< >] -> e :: accumulator 347abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao end stream 357abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< >] -> accumulator 367abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao in 377abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao let rec parse_ident id = parser 387abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* Call. *) 397abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< 'Token.Kwd '('; 407abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao args=parse_args []; 417abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 'Token.Kwd ')' ?? "expected ')'">] -> 427abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao Ast.Call (id, Array.of_list (List.rev args)) 437abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 447abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* Simple variable ref. *) 457abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< >] -> Ast.Variable id 467abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao in 477abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao parse_ident id stream 487abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 497abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* ifexpr ::= 'if' expr 'then' expr 'else' expr *) 507abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< 'Token.If; c=parse_expr; 517abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 'Token.Then ?? "expected 'then'"; t=parse_expr; 527abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 'Token.Else ?? "expected 'else'"; e=parse_expr >] -> 537abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao Ast.If (c, t, e) 547abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 557abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* forexpr 567abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao ::= 'for' identifier '=' expr ',' expr (',' expr)? 'in' expression *) 577abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< 'Token.For; 587abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 'Token.Ident id ?? "expected identifier after for"; 597abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 'Token.Kwd '=' ?? "expected '=' after for"; 607abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao stream >] -> 617abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao begin parser 627abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< 637abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao start=parse_expr; 647abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 'Token.Kwd ',' ?? "expected ',' after for"; 657abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao end_=parse_expr; 667abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao stream >] -> 677abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao let step = 687abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao begin parser 697abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< 'Token.Kwd ','; step=parse_expr >] -> Some step 707abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< >] -> None 717abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao end stream 727abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao in 737abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao begin parser 747abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< 'Token.In; body=parse_expr >] -> 757abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao Ast.For (id, start, end_, step, body) 767abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< >] -> 777abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao raise (Stream.Error "expected 'in' after for") 787abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao end stream 797abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< >] -> 807abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao raise (Stream.Error "expected '=' after for") 817abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao end stream 827abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 837abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< >] -> raise (Stream.Error "unknown token when expecting an expression.") 847abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 857abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao(* unary 867abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao * ::= primary 877abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao * ::= '!' unary *) 887abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liaoand parse_unary = parser 897abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* If this is a unary operator, read it. *) 907abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< 'Token.Kwd op when op != '(' && op != ')'; operand=parse_expr >] -> 917abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao Ast.Unary (op, operand) 927abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 937abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* If the current token is not an operator, it must be a primary expr. *) 947abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< stream >] -> parse_primary stream 957abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 967abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao(* binoprhs 977abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao * ::= ('+' primary)* *) 987abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liaoand parse_bin_rhs expr_prec lhs stream = 997abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao match Stream.peek stream with 1007abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* If this is a binop, find its precedence. *) 1017abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | Some (Token.Kwd c) when Hashtbl.mem binop_precedence c -> 1027abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao let token_prec = precedence c in 1037abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 1047abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* If this is a binop that binds at least as tightly as the current binop, 1057abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao * consume it, otherwise we are done. *) 1067abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao if token_prec < expr_prec then lhs else begin 1077abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* Eat the binop. *) 1087abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao Stream.junk stream; 1097abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 1107abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* Parse the unary expression after the binary operator. *) 1117abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao let rhs = parse_unary stream in 1127abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 1137abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* Okay, we know this is a binop. *) 1147abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao let rhs = 1157abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao match Stream.peek stream with 1167abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | Some (Token.Kwd c2) -> 1177abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* If BinOp binds less tightly with rhs than the operator after 1187abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao * rhs, let the pending operator take rhs as its lhs. *) 1197abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao let next_prec = precedence c2 in 1207abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao if token_prec < next_prec 1217abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao then parse_bin_rhs (token_prec + 1) rhs stream 1227abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao else rhs 1237abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | _ -> rhs 1247abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao in 1257abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 1267abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* Merge lhs/rhs. *) 1277abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao let lhs = Ast.Binary (c, lhs, rhs) in 1287abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao parse_bin_rhs expr_prec lhs stream 1297abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao end 1307abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | _ -> lhs 1317abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 1327abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao(* expression 1337abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao * ::= primary binoprhs *) 1347abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liaoand parse_expr = parser 1357abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< lhs=parse_unary; stream >] -> parse_bin_rhs 0 lhs stream 1367abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 1377abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao(* prototype 1387abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao * ::= id '(' id* ')' 1397abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao * ::= binary LETTER number? (id, id) 1407abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao * ::= unary LETTER number? (id) *) 1417abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liaolet parse_prototype = 1427abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao let rec parse_args accumulator = parser 1437abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< 'Token.Ident id; e=parse_args (id::accumulator) >] -> e 1447abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< >] -> accumulator 1457abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao in 1467abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao let parse_operator = parser 1477abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< 'Token.Unary >] -> "unary", 1 1487abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< 'Token.Binary >] -> "binary", 2 1497abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao in 1507abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao let parse_binary_precedence = parser 1517abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< 'Token.Number n >] -> int_of_float n 1527abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< >] -> 30 1537abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao in 1547abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao parser 1557abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< 'Token.Ident id; 1567abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 'Token.Kwd '(' ?? "expected '(' in prototype"; 1577abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao args=parse_args []; 1587abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 'Token.Kwd ')' ?? "expected ')' in prototype" >] -> 1597abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* success. *) 1607abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao Ast.Prototype (id, Array.of_list (List.rev args)) 1617abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< (prefix, kind)=parse_operator; 1627abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 'Token.Kwd op ?? "expected an operator"; 1637abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* Read the precedence if present. *) 1647abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao binary_precedence=parse_binary_precedence; 1657abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 'Token.Kwd '(' ?? "expected '(' in prototype"; 1667abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao args=parse_args []; 1677abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 'Token.Kwd ')' ?? "expected ')' in prototype" >] -> 1687abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao let name = prefix ^ (String.make 1 op) in 1697abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao let args = Array.of_list (List.rev args) in 1707abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 1717abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* Verify right number of arguments for operator. *) 1727abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao if Array.length args != kind 1737abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao then raise (Stream.Error "invalid number of operands for operator") 1747abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao else 1757abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao if kind == 1 then 1767abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao Ast.Prototype (name, args) 1777abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao else 1787abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao Ast.BinOpPrototype (name, args, binary_precedence) 1797abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< >] -> 1807abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao raise (Stream.Error "expected function name in prototype") 1817abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 1827abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao(* definition ::= 'def' prototype expression *) 1837abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liaolet parse_definition = parser 1847abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< 'Token.Def; p=parse_prototype; e=parse_expr >] -> 1857abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao Ast.Function (p, e) 1867abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 1877abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao(* toplevelexpr ::= expression *) 1887abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liaolet parse_toplevel = parser 1897abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< e=parse_expr >] -> 1907abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao (* Make an anonymous proto. *) 1917abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao Ast.Function (Ast.Prototype ("", [||]), e) 1927abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao 1937abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao(* external ::= 'extern' prototype *) 1947abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liaolet parse_extern = parser 1957abe37e4aee38cc79d91dd069a37d7e91d5bef53Shih-wei Liao | [< 'Token.Extern; e=parse_prototype >] -> e 196