From 52eff4e764a29694e6a9048981352c654aee93db Mon Sep 17 00:00:00 2001
From: Sander Spies <sandermail@gmail.com>
Date: Mon, 16 Dec 2019 15:52:45 +0100
Subject: [PATCH] Incorrect function arguments message for ReasonLIGO.

---
 src/passes/1-parser/dune                   |  2 +-
 src/passes/1-parser/reasonligo.ml          | 13 ++++++++++++-
 src/passes/1-parser/reasonligo/Parser.mly  |  8 ++++----
 src/passes/1-parser/shared/SyntaxError.ml  |  4 ++++
 src/passes/1-parser/shared/SyntaxError.mli |  4 ++++
 src/passes/1-parser/shared/dune            |  1 +
 6 files changed, 26 insertions(+), 6 deletions(-)
 create mode 100644 src/passes/1-parser/shared/SyntaxError.ml
 create mode 100644 src/passes/1-parser/shared/SyntaxError.mli

diff --git a/src/passes/1-parser/dune b/src/passes/1-parser/dune
index 9a4f86a94..8e478b392 100644
--- a/src/passes/1-parser/dune
+++ b/src/passes/1-parser/dune
@@ -12,5 +12,5 @@
   (preprocess
     (pps ppx_let)
   )
-  (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils -open Parser_shared ))
+  (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils -open Parser_shared))
 )
diff --git a/src/passes/1-parser/reasonligo.ml b/src/passes/1-parser/reasonligo.ml
index 8fafc5c95..a3b52b110 100644
--- a/src/passes/1-parser/reasonligo.ml
+++ b/src/passes/1-parser/reasonligo.ml
@@ -22,7 +22,18 @@ let parse_file (source: string) : AST.t result =
   let lexbuf = Lexing.from_channel channel in
   let Lexer.{read ; close ; _} =
     Lexer.open_token_stream None in
-  specific_try (function
+  specific_try (function      
+      | SyntaxError.Error WrongFunctionArguments -> 
+          let start = Lexing.lexeme_start_p lexbuf in
+          let end_ = Lexing.lexeme_end_p lexbuf in
+          let str = Format.sprintf
+              "Incorrect function arguments at \"%s\" from (%d, %d) to (%d, %d). In file \"%s|%s\"\n"
+              (Lexing.lexeme lexbuf)
+              start.pos_lnum (start.pos_cnum - start.pos_bol)
+              end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
+              start.pos_fname source
+          in
+          simple_error str
       | Parser.Error -> (
           let start = Lexing.lexeme_start_p lexbuf in
           let end_ = Lexing.lexeme_end_p lexbuf in
diff --git a/src/passes/1-parser/reasonligo/Parser.mly b/src/passes/1-parser/reasonligo/Parser.mly
index 61edd2349..444d12212 100644
--- a/src/passes/1-parser/reasonligo/Parser.mly
+++ b/src/passes/1-parser/reasonligo/Parser.mly
@@ -424,8 +424,8 @@ fun_expr:
           {p.value with inside = arg_to_pattern p.value.inside}
         in PPar {p with value}
     | EUnit u -> PUnit u
-    | _ -> failwith "Not supported" in (* TODO: raise a proper exception *)
-
+    | _ -> raise (SyntaxError.Error WrongFunctionArguments)
+    in
     let fun_args_to_pattern = function
       EAnnot {
         value = {
@@ -453,8 +453,8 @@ fun_expr:
           in arg_to_pattern (fst fun_args), bindings
       | EUnit e ->
           arg_to_pattern (EUnit e), []
-      | _ -> failwith "Not supported" in (* TODO: raise a proper exception *)
-
+      | _ -> raise (SyntaxError.Error WrongFunctionArguments)
+    in
     let binders = fun_args_to_pattern $1 in
     let f = {kwd_fun;
              binders;
diff --git a/src/passes/1-parser/shared/SyntaxError.ml b/src/passes/1-parser/shared/SyntaxError.ml
new file mode 100644
index 000000000..a0faa0bbb
--- /dev/null
+++ b/src/passes/1-parser/shared/SyntaxError.ml
@@ -0,0 +1,4 @@
+type error = 
+  | WrongFunctionArguments
+
+exception Error of error
\ No newline at end of file
diff --git a/src/passes/1-parser/shared/SyntaxError.mli b/src/passes/1-parser/shared/SyntaxError.mli
new file mode 100644
index 000000000..a0faa0bbb
--- /dev/null
+++ b/src/passes/1-parser/shared/SyntaxError.mli
@@ -0,0 +1,4 @@
+type error = 
+  | WrongFunctionArguments
+
+exception Error of error
\ No newline at end of file
diff --git a/src/passes/1-parser/shared/dune b/src/passes/1-parser/shared/dune
index 3d763b1df..0da93bc70 100644
--- a/src/passes/1-parser/shared/dune
+++ b/src/passes/1-parser/shared/dune
@@ -18,6 +18,7 @@
     FQueue
     EvalOpt
     Version
+    SyntaxError
   )
   (modules_without_implementation Error)
 )