Add column info to Parser

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.Expected (col, t) -> sprintf "expected %s at col %d" t col
-  | Parser.Unexpected_token t -> sprintf "unexpected token \"%s\"" t
+  | 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"

parser.ml

@@ -2,15 +2,15 @@ open Ast
 
 module S = Set.Make(String)
 
-exception Expected of string
+exception Expected of int * string
-exception Unexpected_token of string
+exception Unexpected_token of int * string
 exception End_of_tokens
 
-let expected t =
+let expected col t =
-  raise @@ Expected t
+  raise @@ Expected (col, t)
 
-let unexpected_token t =
+let unexpected_token col t =
-  raise @@ Unexpected_token (Token.to_string 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
+  let col, x, seq = any seq in
-  | Seq.Nil -> expected @@ Token.to_string tok
+  if x = tok then x, seq
-  | Seq.Cons (x, seq) ->
+  else expected col @@ Token.to_string tok
-    if x = tok then x, seq
-    else expected @@ Token.to_string tok
 
 let any_ident seq =
-  match seq () with
+  let col, x, seq = any seq in
-  | Seq.Nil -> expected "ident"
+  match x with
-  | Seq.Cons (x, seq) -> begin match x with
+  | Token.Ident id -> id, seq
-      | Token.Ident id -> id, seq
+  | _ -> expected col "ident"
-      | _ -> unexpected_token x
-    end
 
 let idents set seq =
-  match seq () with
+  let col, x, seq = any seq in
-  | Seq.Nil ->
+  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
+    expected col msg
-  | Seq.Cons (x, seq) -> begin
-      match x with
-      | Token.Ident id when S.mem id set -> id, seq
-      | _ -> unexpected_token x
-    end
 
 let ident str seq =
   idents (S.singleton str) seq
 
 let operator seq =
-  match seq () with
+  let col, x, seq = any seq in
-  | Seq.Nil -> expected "operator"
+  try token_to_op x, seq with
-  | Seq.Cons (x, seq) ->
+  | _ -> expected col "operator"
-    try token_to_op x, seq with
-    | _ -> expected "operator"
 
 (* parser combinators *)
 
@@ -261,12 +252,10 @@ and extern_value seq =
 (* unary := - value *)
 and unary seq =
   let op, seq =
-    match seq () with
+    let col, x, seq = any seq in
-    | Seq.Nil -> raise End_of_tokens
+    if x = Minus
-    | Seq.Cons (x, seq) ->
+    then Negate, seq
-      if x = Minus
+    else expected col "minus (-)"
-      then Negate, seq
-      else expected "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
+      | RParen -> left, Seq.cons (col, x) seq
-      | Ident id when is_keyword id -> left, Seq.cons x seq
+      | Ident id when is_keyword id -> left, Seq.cons (col, x) seq
-      | _ -> unexpected_token x
+      | _ -> 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