diff --git a/main.ml b/main.ml index 77654f2..0e4e571 100644 --- a/main.ml +++ b/main.ml @@ -9,8 +9,9 @@ let error_to_string e = | Lex.Invalid_character (col, c) -> sprintf "invalid character %c at col %d" c col | Lex.Expected (col, c) -> sprintf "expected %c at col %d" c col - | Parser.Expected t -> sprintf "expected %s" t - | Parser.Unexpected_token t -> sprintf "unexpected token \"%s\"" t + | Parser.Expected (col, t) -> sprintf "expected %s at col %d" t col + | Parser.Unexpected_token (col, t) -> + sprintf "unexpected token \"%s\" at col %d" t col | Type.Invalid t -> sprintf "invalid type %s" (Type.to_string t) | Eval.Unbound v -> sprintf "unbound value %s" v | Eval.Too_many_arguments -> "applied too many arguments" diff --git a/parser.ml b/parser.ml index 8e35aae..b9ee9e3 100644 --- a/parser.ml +++ b/parser.ml @@ -2,15 +2,15 @@ open Ast module S = Set.Make(String) -exception Expected of string -exception Unexpected_token of string +exception Expected of int * string +exception Unexpected_token of int * string exception End_of_tokens -let expected t = - raise @@ Expected t +let expected col t = + raise @@ Expected (col, t) -let unexpected_token t = - raise @@ Unexpected_token (Token.to_string t) +let unexpected_token col t = + raise @@ Unexpected_token (col, Token.to_string t) (* precedence table. * my first thought was using some sort of partially-ordered graph for @@ -89,43 +89,34 @@ let is_keyword = function let any seq = match seq () with | Seq.Nil -> raise End_of_tokens - | Seq.Cons (x, seq) -> x, seq + | Seq.Cons ((col, x), seq) -> col, x, seq let token tok seq = - match seq () with - | Seq.Nil -> expected @@ Token.to_string tok - | Seq.Cons (x, seq) -> - if x = tok then x, seq - else expected @@ Token.to_string tok + let col, x, seq = any seq in + if x = tok then x, seq + else expected col @@ Token.to_string tok let any_ident seq = - match seq () with - | Seq.Nil -> expected "ident" - | Seq.Cons (x, seq) -> begin match x with - | Token.Ident id -> id, seq - | _ -> unexpected_token x - end + let col, x, seq = any seq in + match x with + | Token.Ident id -> id, seq + | _ -> expected col "ident" let idents set seq = - match seq () with - | Seq.Nil -> + let col, x, seq = any seq in + match x with + | Token.Ident id when S.mem id set -> id, seq + | _ -> let msg = "ident " ^ (S.elements set |> String.concat " or ") in - expected msg - | Seq.Cons (x, seq) -> begin - match x with - | Token.Ident id when S.mem id set -> id, seq - | _ -> unexpected_token x - end + expected col msg let ident str seq = idents (S.singleton str) seq let operator seq = - match seq () with - | Seq.Nil -> expected "operator" - | Seq.Cons (x, seq) -> - try token_to_op x, seq with - | _ -> expected "operator" + let col, x, seq = any seq in + try token_to_op x, seq with + | _ -> expected col "operator" (* parser combinators *) @@ -261,12 +252,10 @@ and extern_value seq = (* unary := - value *) and unary seq = let op, seq = - match seq () with - | Seq.Nil -> raise End_of_tokens - | Seq.Cons (x, seq) -> - if x = Minus - then Negate, seq - else expected "minus" + let col, x, seq = any seq in + if x = Minus + then Negate, seq + else expected col "minus (-)" in let v, seq = value seq in Ast.unary op v, seq @@ -275,7 +264,7 @@ and unary seq = and value seq = match seq () with | Seq.Nil -> raise End_of_tokens - | Seq.Cons (x, seq) -> begin match x with + | Seq.Cons ((col, x), seq) -> begin match x with | Ident id when is_keyword id -> failwith "value" | Ident "true" -> Nbool true, seq | Ident "false" -> Nbool false, seq @@ -284,20 +273,20 @@ and value seq = | Float x -> Nfloat x, seq | String x -> Nstring x, seq | Hash -> - let t, seq = any seq in + let _, t, seq = any seq in Nsymbol (Token.to_string t), seq | LParen -> let e, seq = expr min_int seq in let _, seq = token RParen seq in e, seq - | _ -> unexpected_token x + | _ -> unexpected_token col x end (* binop := binop op binop *) and binop pre left seq = match seq () with | Seq.Nil -> left, Seq.empty - | Seq.Cons (x, seq) -> begin match x with + | Seq.Cons ((col, x), seq) -> begin match x with | op when token_is_operator op -> let op = token_to_op op in let op_pre = precedence_of op in @@ -308,16 +297,15 @@ and binop pre left seq = let right, seq = expr op_pre seq in binop pre (Ast.binop left op right) seq else - left, Seq.cons x seq + left, Seq.cons (col, x) seq - | RParen -> left, Seq.cons x seq - | Ident id when is_keyword id -> left, Seq.cons x seq - | _ -> unexpected_token x + | RParen -> left, Seq.cons (col, x) seq + | Ident id when is_keyword id -> left, Seq.cons (col, x) seq + | _ -> unexpected_token col x end (* parse tokens *) let parse ts = - let ts = Seq.map snd ts in let ast, rest = decl ts in if rest () <> Seq.Nil then failwith "Parser.parse"; ast