allow ->, add some tests

grain-lang · Jun 13, 2023 · 6d88859 · 6d88859
1 parent c5cdab8
commit 6d88859
Show file tree

Hide file tree

Showing 6 changed files with 56 additions and 10 deletions.
diff --git a/compiler/src/parsing/lexer.re b/compiler/src/parsing/lexer.re
@@ -309,6 +309,7 @@ let rec token = lexbuf => {
   | "/" => positioned(SLASH)
   | "|" => positioned(PIPE)
   | "-" => positioned(DASH)
+  | "->" => positioned(ARROW)
   | "=>" => positioned(THICKARROW)
   | "type" => positioned(TYPE)
   | "enum" => positioned(ENUM)

diff --git a/compiler/src/parsing/parser.mly b/compiler/src/parsing/parser.mly
@@ -20,7 +20,7 @@ module Grain_parsing = struct end
 %token <string> STRING BYTES CHAR
 %token LBRACK LBRACKRCARET RBRACK LPAREN RPAREN LBRACE RBRACE LCARET RCARET
 %token COMMA SEMI AS
-%token THICKARROW
+%token THICKARROW ARROW
 %token EQUAL GETS
 %token UNDERSCORE
 %token COLON QUESTION DOT ELLIPSIS
@@ -98,6 +98,7 @@ module Grain_parsing = struct end
   lcaret
   comma
   eos
+  arrow
   thickarrow
   equal
   const
@@ -188,9 +189,16 @@ comma:
 %inline dot:
   | DOT opt_eols {}
 
+arrow:
+  | ARROW opt_eols {}
+
 thickarrow:
   | THICKARROW opt_eols {}
 
+either_arrow:
+  | arrow {}
+  | thickarrow {}
+
 equal:
   | EQUAL opt_eols {}
 
@@ -295,9 +303,9 @@ data_typ:
   | qualified_uid %prec _below_infix { Type.constr ~loc:(to_loc $loc) $1 [] }
 
 typ:
-  | FUN data_typ thickarrow typ { Type.arrow ~loc:(to_loc $loc) [TypeArgument.mk ~loc:(to_loc $loc($2)) Unlabeled $2] $4 }
-  | FUN LIDENT thickarrow typ { Type.arrow ~loc:(to_loc $loc) [TypeArgument.mk ~loc:(to_loc $loc($2)) Unlabeled (Type.var $2)] $4 }
-  | FUN lparen arg_typs? rparen thickarrow typ { Type.arrow ~loc:(to_loc $loc) (Option.value ~default:[] $3) $6 }
+  | FUN data_typ either_arrow typ { Type.arrow ~loc:(to_loc $loc) [TypeArgument.mk ~loc:(to_loc $loc($2)) Unlabeled $2] $4 }
+  | FUN LIDENT either_arrow typ { Type.arrow ~loc:(to_loc $loc) [TypeArgument.mk ~loc:(to_loc $loc($2)) Unlabeled (Type.var $2)] $4 }
+  | FUN lparen arg_typs? rparen either_arrow typ { Type.arrow ~loc:(to_loc $loc) (Option.value ~default:[] $3) $6 }
   | lparen tuple_typs rparen { Type.tuple ~loc:(to_loc $loc) $2 }
   | lparen typ rparen { $2 }
   | LIDENT { Type.var ~loc:(to_loc $loc) $1 }

diff --git a/compiler/src/parsing/wrapped_lexer.re b/compiler/src/parsing/wrapped_lexer.re
@@ -67,7 +67,8 @@ let inject_fun =
 
 let is_triggering_token =
   fun
-  | (THICKARROW, _, _) => true
+  | (THICKARROW, _, _)
+  | (ARROW, _, _) => true
   | _ => false;
 
 let rec lex_fast_forward_step = (state, stop, acc, tok) => {
@@ -150,9 +151,10 @@ and check_data_typ = (state, closing, acc) => {
     lex_balanced_step(state, closing, rest @ acc, token)
   | [token, ...rest] =>
     let acc =
-      switch (token) {
-      | (THICKARROW, _, _) => inject_fun(acc)
-      | _ => acc
+      if (is_triggering_token(token)) {
+        inject_fun(acc);
+      } else {
+        acc;
       };
     lex_balanced_step(state, closing, rest @ acc, token);
   | _ => failwith("Impossible: wrapped_lexer check_data_typ not matched")
@@ -300,7 +302,7 @@ and lookahead_fun_data_typ = (state, uident) => {
     state.queued_tokens = List.rev(tokens);
     state.queued_exn = exn;
     uident;
-  | [(THICKARROW, _, _), ..._] as tokens =>
+  | [token, ..._] as tokens when is_triggering_token(token) =>
     state.queued_tokens = [uident, ...List.rev(tokens)];
     fake_triple(FUN, uident);
   | tokens =>

diff --git a/compiler/test/grainfmt/function_params.expected.gr b/compiler/test/grainfmt/function_params.expected.gr
@@ -39,3 +39,5 @@ let stringTailMatcher = (toMatch, len) =>
   ) => {
   true
 }
+
+let f: Number => (Number, Number) => Number = a => (b, c) => a + b + c
diff --git a/compiler/test/grainfmt/function_params.input.gr b/compiler/test/grainfmt/function_params.input.gr
@@ -32,3 +32,5 @@ let stringTailMatcher =  (toMatch, len) =>
   ) => {
     true
   }
+
+let f: Number -> (Number, Number) -> Number = a => (b, c) => a + b + c
diff --git a/compiler/test/suites/types.re b/compiler/test/suites/types.re
@@ -371,7 +371,7 @@ describe("function types", ({test, testSkip}) => {
   let test_or_skip =
     Sys.backend_type == Other("js_of_ocaml") ? testSkip : test;
 
-  // let assertCompileError = makeCompileErrorRunner(test);
+  let assertCompileError = makeCompileErrorRunner(test);
   let assertRun = makeRunner(test_or_skip);
 
   assertRun(
@@ -429,4 +429,35 @@ describe("function types", ({test, testSkip}) => {
     |},
     "1\n",
   );
+  assertCompileError(
+    "type_fn_6",
+    {|
+      let badIdentity: x => x
+      print(badIdentity(1))
+    |},
+    "Syntax error after 'x' and before ' '.\nExpected a type annotation or `=`.",
+  );
+  assertCompileError(
+    "type_fn_7",
+    {|
+      let badFn: Number =>
+    |},
+    "Syntax error after ' ' and before ''.\nExpected a type for the result of the function type.",
+  );
+  assertCompileError(
+    "type_fn_8",
+    {|
+      let badFn: Number =>
+      print(badFn(1))
+    |},
+    "Syntax error after 'print' and before '\\('.\nExpected a type annotation or `=`.",
+  );
+  assertCompileError(
+    "type_fn_9",
+    {|
+      let badFn: (Number => )
+      print(badFn(1))
+    |},
+    "Syntax error after '=>' and before '\\)'.\nExpected a type for the result of the function type.",
+  );
 });