Merge pull request #137 from EmileRolley/feat-list-concat

Feat #109: add collection concatenation operator

compiler/dcalc/ast.ml

@@ -85,6 +85,7 @@ type binop =
   | Eq
   | Neq
   | Map
+  | Concat
   | Filter
 
 type log_entry = VarDef of typ | BeginCall | EndCall | PosRecordIfTrueBool

compiler/dcalc/ast.mli

@@ -61,7 +61,7 @@ type op_kind =
   | KRat
   | KMoney
   | KDate
-  | KDuration  (** All ops don't have a Kdate and KDuration *)
+  | KDuration  (** All ops don't have a KDate and KDuration. *)
 
 type ternop = Fold
 
@@ -80,6 +80,7 @@ type binop =
   | Eq
   | Neq
   | Map
+  | Concat
   | Filter
 
 type log_entry =

compiler/dcalc/interpreter.ml

@@ -188,6 +188,7 @@ let rec evaluate_operator (ctx : Ast.decl_ctx) (op : A.operator Pos.marked)
         match Pos.unmark (evaluate_operator ctx (Pos.same_pos_as (A.Binop A.Eq) op) args) with
         | A.ELit (A.LBool b) -> A.ELit (A.LBool (not b))
         | _ -> assert false (*should not happen *))
+    | A.Binop A.Concat, [ A.EArray es1; A.EArray es2 ] -> A.EArray (es1 @ es2)
     | A.Binop A.Map, [ _; A.EArray es ] ->
         A.EArray
           (List.map

compiler/dcalc/print.ml

@@ -55,14 +55,15 @@ let format_operator (fmt : Format.formatter) (s : string) : unit =
   Format.fprintf fmt "%s" (Utils.Cli.print_with_style [ ANSITerminal.green ] "%s" s)
 
 let format_tlit (fmt : Format.formatter) (l : typ_lit) : unit =
-  match l with
-  | TUnit -> format_base_type fmt "unit"
-  | TBool -> format_base_type fmt "bool"
-  | TInt -> format_base_type fmt "integer"
-  | TRat -> format_base_type fmt "decimal"
-  | TMoney -> format_base_type fmt "money"
-  | TDuration -> format_base_type fmt "duration"
-  | TDate -> format_base_type fmt "date"
+  format_base_type fmt
+    (match l with
+    | TUnit -> "unit"
+    | TBool -> "bool"
+    | TInt -> "integer"
+    | TRat -> "decimal"
+    | TMoney -> "money"
+    | TDuration -> "duration"
+    | TDate -> "date")
 
 let rec format_typ (ctx : Ast.decl_ctx) (fmt : Format.formatter) (typ : typ Pos.marked) : unit =
   let format_typ = format_typ ctx in
@@ -109,33 +110,35 @@ let format_op_kind (fmt : Format.formatter) (k : op_kind) =
     (match k with KInt -> "" | KRat -> "." | KMoney -> "$" | KDate -> "@" | KDuration -> "^")
 
 let format_binop (fmt : Format.formatter) (op : binop Pos.marked) : unit =
-  match Pos.unmark op with
-  | Add k -> format_operator fmt (Format.asprintf "+%a" format_op_kind k)
-  | Sub k -> format_operator fmt (Format.asprintf "-%a" format_op_kind k)
-  | Mult k -> format_operator fmt (Format.asprintf "*%a" format_op_kind k)
-  | Div k -> format_operator fmt (Format.asprintf "/%a" format_op_kind k)
-  | And -> format_operator fmt (Format.asprintf "%s" "&&")
-  | Or -> format_operator fmt (Format.asprintf "%s" "||")
-  | Xor -> format_operator fmt (Format.asprintf "%s" "xor")
-  | Eq -> format_operator fmt (Format.asprintf "%s" "=")
-  | Neq -> format_operator fmt (Format.asprintf "%s" "!=")
-  | Lt k -> format_operator fmt (Format.asprintf "%s%a" "<" format_op_kind k)
-  | Lte k -> format_operator fmt (Format.asprintf "%s%a" "<=" format_op_kind k)
-  | Gt k -> format_operator fmt (Format.asprintf "%s%a" ">" format_op_kind k)
-  | Gte k -> format_operator fmt (Format.asprintf "%s%a" ">=" format_op_kind k)
-  | Map -> format_keyword fmt "map"
-  | Filter -> format_keyword fmt "filter"
+  format_operator fmt
+    (match Pos.unmark op with
+    | Add k -> Format.asprintf "+%a" format_op_kind k
+    | Sub k -> Format.asprintf "-%a" format_op_kind k
+    | Mult k -> Format.asprintf "*%a" format_op_kind k
+    | Div k -> Format.asprintf "/%a" format_op_kind k
+    | And -> "&&"
+    | Or -> "||"
+    | Xor -> "xor"
+    | Eq -> "="
+    | Neq -> "!="
+    | Lt k -> Format.asprintf "%s%a" "<" format_op_kind k
+    | Lte k -> Format.asprintf "%s%a" "<=" format_op_kind k
+    | Gt k -> Format.asprintf "%s%a" ">" format_op_kind k
+    | Gte k -> Format.asprintf "%s%a" ">=" format_op_kind k
+    | Concat -> "++"
+    | Map -> "map"
+    | Filter -> "filter")
 
 let format_ternop (fmt : Format.formatter) (op : ternop Pos.marked) : unit =
   match Pos.unmark op with Fold -> format_keyword fmt "fold"
 
 let format_log_entry (fmt : Format.formatter) (entry : log_entry) : unit =
-  match entry with
-  | VarDef _ -> Format.fprintf fmt "%s" (Utils.Cli.print_with_style [ ANSITerminal.blue ] "≔ ")
-  | BeginCall -> Format.fprintf fmt "%s" (Utils.Cli.print_with_style [ ANSITerminal.yellow ] "→ ")
-  | EndCall -> Format.fprintf fmt "%s" (Utils.Cli.print_with_style [ ANSITerminal.yellow ] "← ")
-  | PosRecordIfTrueBool ->
-      Format.fprintf fmt "%s" (Utils.Cli.print_with_style [ ANSITerminal.green ] "☛ ")
+  Format.fprintf fmt "%s"
+    (match entry with
+    | VarDef _ -> Utils.Cli.print_with_style [ ANSITerminal.blue ] "≔ "
+    | BeginCall -> Utils.Cli.print_with_style [ ANSITerminal.yellow ] "→ "
+    | EndCall -> Utils.Cli.print_with_style [ ANSITerminal.yellow ] "← "
+    | PosRecordIfTrueBool -> Utils.Cli.print_with_style [ ANSITerminal.green ] "☛ ")
 
 let format_unop (fmt : Format.formatter) (op : unop Pos.marked) : unit =
   Format.fprintf fmt "%s"

compiler/dcalc/typing.ml

@@ -165,6 +165,7 @@ let op_type (op : A.operator Pos.marked) : typ Pos.marked UnionFind.elem =
   | A.Binop (A.Eq | A.Neq) -> arr any (arr any bt)
   | A.Binop A.Map -> arr (arr any any2) (arr array_any array_any2)
   | A.Binop A.Filter -> arr (arr any bt) (arr array_any array_any)
+  | A.Binop A.Concat -> arr array_any (arr array_any array_any)
   | A.Unop (A.Minus KInt) -> arr it it
   | A.Unop (A.Minus KRat) -> arr rt rt
   | A.Unop (A.Minus KMoney) -> arr mt mt

compiler/lcalc/print.ml

@@ -57,11 +57,12 @@ let format_uid_list (fmt : Format.formatter) (infos : Uid.MarkedString.info list
     infos
 
 let format_exception (fmt : Format.formatter) (exn : except) : unit =
-  match exn with
-  | EmptyError -> Format.fprintf fmt "EmptyError"
-  | ConflictError -> Format.fprintf fmt "ConflictError"
-  | Crash -> Format.fprintf fmt "Crash"
-  | NoValueProvided -> Format.fprintf fmt "NoValueProvided"
+  Format.fprintf fmt
+    (match exn with
+    | EmptyError -> "EmptyError"
+    | ConflictError -> "ConflictError"
+    | Crash -> "Crash"
+    | NoValueProvided -> "NoValueProvided")
 
 let format_keyword (fmt : Format.formatter) (s : string) : unit =
   Format.fprintf fmt "%s" (Utils.Cli.print_with_style [ ANSITerminal.red ] "%s" s)

compiler/lcalc/to_ocaml.ml

@@ -42,11 +42,12 @@ let format_op_kind (fmt : Format.formatter) (k : Dcalc.Ast.op_kind) =
     (match k with KInt -> "!" | KRat -> "&" | KMoney -> "$" | KDate -> "@" | KDuration -> "^")
 
 let format_log_entry (fmt : Format.formatter) (entry : Dcalc.Ast.log_entry) : unit =
-  match entry with
-  | VarDef _ -> Format.fprintf fmt ":="
-  | BeginCall -> Format.fprintf fmt "→ "
-  | EndCall -> Format.fprintf fmt "%s" "← "
-  | PosRecordIfTrueBool -> Format.fprintf fmt "☛ "
+  Format.fprintf fmt "%s"
+    (match entry with
+    | VarDef _ -> ":="
+    | BeginCall -> "→ "
+    | EndCall -> "← "
+    | PosRecordIfTrueBool -> "☛ ")
 
 let format_binop (fmt : Format.formatter) (op : Dcalc.Ast.binop Pos.marked) : unit =
   match Pos.unmark op with
@@ -62,6 +63,7 @@ let format_binop (fmt : Format.formatter) (op : Dcalc.Ast.binop Pos.marked) : un
   | Lte k -> Format.fprintf fmt "%s%a" "<=" format_op_kind k
   | Gt k -> Format.fprintf fmt "%s%a" ">" format_op_kind k
   | Gte k -> Format.fprintf fmt "%s%a" ">=" format_op_kind k
+  | Concat -> Format.fprintf fmt "@"
   | Map -> Format.fprintf fmt "Array.map"
   | Filter -> Format.fprintf fmt "array_filter"
 

compiler/scalc/to_python.ml

@@ -49,7 +49,7 @@ let format_log_entry (fmt : Format.formatter) (entry : Dcalc.Ast.log_entry) : un
 
 let format_binop (fmt : Format.formatter) (op : Dcalc.Ast.binop Pos.marked) : unit =
   match Pos.unmark op with
-  | Add _ -> Format.fprintf fmt "+"
+  | Add _ | Concat -> Format.fprintf fmt "+"
   | Sub _ -> Format.fprintf fmt "-"
   | Mult _ -> Format.fprintf fmt "*"
   | Div D.KInt -> Format.fprintf fmt "//"

compiler/surface/ast.ml

@@ -177,6 +177,7 @@ type binop =
   | Gte of op_kind
   | Eq
   | Neq
+  | Concat
 [@@deriving
   visitors { variety = "map"; ancestors = [ "op_kind_map" ]; name = "binop_map"; nude = true },
     visitors { variety = "iter"; ancestors = [ "op_kind_iter" ]; name = "binop_iter"; nude = true }]

compiler/surface/desugaring.ml

@@ -44,6 +44,7 @@ let translate_binop (op : Ast.binop) : Dcalc.Ast.binop =
   | Gte l -> Gte (translate_op_kind l)
   | Eq -> Eq
   | Neq -> Neq
+  | Concat -> Concat
 
 let translate_unop (op : Ast.unop) : Dcalc.Ast.unop =
   match op with Not -> Not | Minus l -> Minus (translate_op_kind l)

compiler/surface/lexer_common.ml

@@ -77,6 +77,7 @@ let token_list_language_agnostic : (string * token) list =
     (":", COLON);
     (";", SEMICOLON);
     ("--", ALT);
+    ("++", CONCAT);
   ]
 
 module type LocalisedLexer = sig

compiler/surface/lexer_en.ml

@@ -480,6 +480,9 @@ let rec lex_code (lexbuf : lexbuf) : token =
   | "--" ->
       L.update_acc lexbuf;
       ALT
+  | "++" ->
+      L.update_acc lexbuf;
+      CONCAT
   | '.' ->
       L.update_acc lexbuf;
       DOT

compiler/surface/lexer_fr.ml

@@ -483,6 +483,9 @@ let rec lex_code (lexbuf : lexbuf) : token =
   | "--" ->
       L.update_acc lexbuf;
       ALT
+  | "++" ->
+      L.update_acc lexbuf;
+      CONCAT
   | '.' ->
       L.update_acc lexbuf;
       DOT

compiler/surface/lexer_pl.ml

@@ -487,6 +487,9 @@ let rec lex_code (lexbuf : lexbuf) : token =
   | "--" ->
       L.update_acc lexbuf;
       ALT
+  | "++" ->
+      L.update_acc lexbuf;
+      CONCAT
   | '.' ->
       L.update_acc lexbuf;
       DOT

compiler/surface/parser.mly

@@ -231,6 +231,7 @@ sum_op:
 | MINUSDEC { (Sub KDec, Pos.from_lpos $sloc) }
 | PLUS { (Add KInt, Pos.from_lpos $sloc) }
 | MINUS { (Sub KInt, Pos.from_lpos $sloc) }
+| CONCAT { (Concat, Pos.from_lpos $sloc) }
 
 sum_unop:
 | MINUS { (Minus KInt, Pos.from_lpos $sloc) }

compiler/surface/tokens.mly

@@ -47,6 +47,7 @@
 %token PLUSDEC MINUSDEC MULTDEC DIVDEC
 %token PLUSMONEY MINUSMONEY MULTMONEY DIVMONEY
 %token MINUSDATE PLUSDATE PLUSDURATION MINUSDURATION DIVDURATION
+%token CONCAT
 %token MATCH WITH VARIES WITH_V WILDCARD
 %token FOR ALL WE_HAVE INCREASING DECREASING
 %token NOT BOOLEAN PERCENT DURATION

french_law/js/package-lock.json

@@ -6,13 +6,14 @@
   "packages": {
     "": {
       "name": "french_law",
-      "version": "0.3.0",
+      "version": "0.4.0",
       "license": "Apache-2.0",
       "dependencies": {
         "benchmark": "^2.1.4",
         "lodash": "^4.17.21",
         "platform": "^1.3.6"
-      }
+      },
+      "devDependencies": {}
     },
     "node_modules/benchmark": {
       "version": "2.1.4",

tests/test_array/good/concatenation.catala_en

@@ -0,0 +1,11 @@
+## Unit testing for collection concatenation.
+
+```catala
+declaration scope A:
+   context x content collection integer
+   context y content collection integer
+
+scope A:
+   definition x equals [0; 1; 2] ++ [3; 4; 5; 6]
+   definition y equals x ++ ([7; 8; 9] ++ [10])
+```

tests/test_array/good/output/concatenation.catala_en.A.out

@@ -0,0 +1,3 @@
+[RESULT] Computation successful! Results:
+[RESULT] x = [0; 1; 2; 3; 4; 5; 6]
+[RESULT] y = [0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10]