Separate token definitions from the parser

src/catala/surface/dune

@@ -15,8 +15,13 @@
   (pps sedlex.ppx visitors.ppx)))
 
 (menhir
- (modules parser)
- (flags --table))
+ (modules tokens)
+ (flags --only-tokens))
+
+(menhir
+ (modules tokens parser)
+ (merge_into parser)
+ (flags --external-tokens Tokens --table))
 
 (documentation
  (package catala)
@@ -27,17 +32,19 @@
 (rule
  (with-stdout-to
   parser.messages.new
-  (run menhir %{dep:parser.mly} --list-errors)))
+  (run menhir %{dep:tokens.mly} %{dep:parser.mly} --base parser --list-errors)))
 
 (rule
  (with-stdout-to
   parser_errors.ml
-  (run menhir %{dep:parser.mly} --compile-errors %{dep:parser.messages})))
+  (run menhir %{dep:tokens.mly} %{dep:parser.mly} --base parser
+    --compile-errors %{dep:parser.messages})))
 
 (rule
  (with-stdout-to
   parser.messages.updated
-  (run menhir %{dep:parser.mly} --update-errors %{dep:parser.messages})))
+  (run menhir %{dep:tokens.mly} %{dep:parser.mly} --base parser
+    --update-errors %{dep:parser.messages})))
 
 (rule
  (alias update-parser-messages)

src/catala/surface/lexer.ml

@@ -14,7 +14,7 @@
 
 (** Concise syntax with English abbreviated keywords. *)
 
-open Parser
+open Tokens
 open Sedlexing
 open Utils
 open Lexer_common

src/catala/surface/lexer_en.ml

@@ -12,7 +12,7 @@
    or implied. See the License for the specific language governing permissions and limitations under
    the License. *)
 
-open Parser
+open Tokens
 open Sedlexing
 open Utils
 open Lexer_common

src/catala/surface/lexer_fr.ml

@@ -12,7 +12,7 @@
    or implied. See the License for the specific language governing permissions and limitations under
    the License. *)
 
-open Parser
+open Tokens
 open Sedlexing
 open Utils
 open Lexer_common

src/catala/surface/parser.mly

@@ -17,49 +17,9 @@
   *)
 
 %{
-  open Ast
   open Utils
   %}
 
-%token EOF
-%token<string * string option * string option * int> LAW_ARTICLE
-%token<string * int> LAW_HEADING
-%token<Ast.law_include> LAW_INCLUDE
-%token<string> LAW_TEXT
-%token<string> CONSTRUCTOR IDENT
-%token<string> END_CODE
-%token<Runtime.integer> INT_LITERAL
-%token TRUE FALSE
-%token<Runtime.integer * Runtime.integer> DECIMAL_LITERAL
-%token<Runtime.integer * Runtime.integer> MONEY_AMOUNT
-%token BEGIN_CODE TEXT MASTER_FILE
-%token COLON ALT DATA VERTICAL
-%token OF INTEGER COLLECTION
-%token RULE CONDITION DEFINED_AS
-%token LESSER GREATER LESSER_EQUAL GREATER_EQUAL
-%token LESSER_DEC GREATER_DEC LESSER_EQUAL_DEC GREATER_EQUAL_DEC
-%token LESSER_MONEY GREATER_MONEY LESSER_EQUAL_MONEY GREATER_EQUAL_MONEY
-%token LESSER_DATE GREATER_DATE LESSER_EQUAL_DATE GREATER_EQUAL_DATE
-%token LESSER_DURATION GREATER_DURATION LESSER_EQUAL_DURATION GREATER_EQUAL_DURATION
-%token EXISTS IN SUCH THAT
-%token DOT AND OR XOR LPAREN RPAREN EQUAL
-%token CARDINAL ASSERTION FIXED BY YEAR MONTH DAY
-%token PLUS MINUS MULT DIV
-%token PLUSDEC MINUSDEC MULTDEC DIVDEC
-%token PLUSMONEY MINUSMONEY MULTMONEY DIVMONEY
-%token MINUSDATE PLUSDATE PLUSDURATION MINUSDURATION
-%token MATCH WITH VARIES WITH_V
-%token FOR ALL WE_HAVE INCREASING DECREASING
-%token NOT BOOLEAN PERCENT DURATION
-%token SCOPE FILLED NOT_EQUAL DEFINITION
-%token STRUCT CONTENT IF THEN DEPENDS DECLARATION
-%token CONTEXT ENUM ELSE DATE SUM
-%token BEGIN_METADATA END_METADATA MONEY DECIMAL
-%token UNDER_CONDITION CONSEQUENCE LBRACKET RBRACKET
-%token LABEL EXCEPTION LSQUARE RSQUARE SEMICOLON
-%token INT_TO_DEC MAXIMUM MINIMUM INIT
-%token GET_DAY GET_MONTH GET_YEAR
-%token FILTER MAP
 
 %type <Ast.source_file_or_master> source_file_or_master
 

src/catala/surface/parser_driver.ml

@@ -214,6 +214,9 @@ let sedlex_with_menhir (lexer' : lexbuf -> Parser.token) (token_list : (string *
 
 (** {1 Parsing multiple files}*)
 
+let localised_lexers : (Cli.frontend_lang * (module Lexer.LocalisedLexer)) list =
+  [ (`Fr, (module Lexer_fr)); (`En, (module Lexer_en)); (`NonVerbose, (module Lexer)) ]
+
 (** Parses a single source file *)
 let rec parse_source_file (source_file : Pos.input_file) (language : Cli.frontend_lang) :
     Ast.program =
@@ -231,17 +234,10 @@ let rec parse_source_file (source_file : Pos.input_file) (language : Cli.fronten
   let source_file_name = match source_file with FileName s -> s | Contents _ -> "stdin" in
   Sedlexing.set_filename lexbuf source_file_name;
   Parse_utils.current_file := source_file_name;
-  let lexer_lang =
-    match language with `Fr -> Lexer_fr.lexer | `En -> Lexer_en.lexer | `NonVerbose -> Lexer.lexer
-  in
-  let token_list_lang =
-    match language with
-    | `Fr -> Lexer_fr.token_list_fr
-    | `En -> Lexer_en.token_list_en
-    | `NonVerbose -> Lexer.token_list
-  in
+  let module LocalisedLexer = (val List.assoc language localised_lexers) in
   let commands_or_includes =
-    sedlex_with_menhir lexer_lang token_list_lang Parser.Incremental.source_file_or_master lexbuf
+    sedlex_with_menhir LocalisedLexer.lexer LocalisedLexer.token_list
+      Parser.Incremental.source_file_or_master lexbuf
   in
   (match input with Some input -> close_in input | None -> ());
   match commands_or_includes with

src/catala/surface/tokens.mly

@@ -0,0 +1,64 @@
+(*
+  This file is part of the Catala compiler, a specification language for tax and social benefits
+  computation rules.
+  Copyright (C) 2020 Inria, contributor: Denis Merigoux <denis.merigoux@inria.fr>
+
+  Licensed under the Apache License, Version 2.0 (the "License");
+  you may not use this file except in compliance with the License.
+  You may obtain a copy of the License at
+
+      http://www.apache.org/licenses/LICENSE-2.0
+
+  Unless required by applicable law or agreed to in writing, software
+  distributed under the License is distributed on an "AS IS" BASIS,
+  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+  See the License for the specific language governing permissions and
+  limitations under the License.
+  *)
+
+%{
+  open Ast
+%}
+
+%token EOF
+%token<string * string option * string option * int> LAW_ARTICLE
+%token<string * int> LAW_HEADING
+%token<Ast.law_include> LAW_INCLUDE
+%token<string> LAW_TEXT
+%token<string> CONSTRUCTOR IDENT
+%token<string> END_CODE
+%token<Runtime.integer> INT_LITERAL
+%token TRUE FALSE
+%token<Runtime.integer * Runtime.integer> DECIMAL_LITERAL
+%token<Runtime.integer * Runtime.integer> MONEY_AMOUNT
+%token BEGIN_CODE TEXT MASTER_FILE
+%token COLON ALT DATA VERTICAL
+%token OF INTEGER COLLECTION
+%token RULE CONDITION DEFINED_AS
+%token LESSER GREATER LESSER_EQUAL GREATER_EQUAL
+%token LESSER_DEC GREATER_DEC LESSER_EQUAL_DEC GREATER_EQUAL_DEC
+%token LESSER_MONEY GREATER_MONEY LESSER_EQUAL_MONEY GREATER_EQUAL_MONEY
+%token LESSER_DATE GREATER_DATE LESSER_EQUAL_DATE GREATER_EQUAL_DATE
+%token LESSER_DURATION GREATER_DURATION LESSER_EQUAL_DURATION GREATER_EQUAL_DURATION
+%token EXISTS IN SUCH THAT
+%token DOT AND OR XOR LPAREN RPAREN EQUAL
+%token CARDINAL ASSERTION FIXED BY YEAR MONTH DAY
+%token PLUS MINUS MULT DIV
+%token PLUSDEC MINUSDEC MULTDEC DIVDEC
+%token PLUSMONEY MINUSMONEY MULTMONEY DIVMONEY
+%token MINUSDATE PLUSDATE PLUSDURATION MINUSDURATION
+%token MATCH WITH VARIES WITH_V
+%token FOR ALL WE_HAVE INCREASING DECREASING
+%token NOT BOOLEAN PERCENT DURATION
+%token SCOPE FILLED NOT_EQUAL DEFINITION
+%token STRUCT CONTENT IF THEN DEPENDS DECLARATION
+%token CONTEXT ENUM ELSE DATE SUM
+%token BEGIN_METADATA END_METADATA MONEY DECIMAL
+%token UNDER_CONDITION CONSEQUENCE LBRACKET RBRACKET
+%token LABEL EXCEPTION LSQUARE RSQUARE SEMICOLON
+%token MAXIMUM MINIMUM INIT
+%token INT_TO_DEC
+%token GET_DAY GET_MONTH GET_YEAR
+%token FILTER MAP
+
+%%