From 5f045110b969954bc5ad9dc1e251af6425be964a Mon Sep 17 00:00:00 2001
From: Denis Merigoux <denis.merigoux@gmail.com>
Date: Tue, 28 Nov 2023 14:14:26 +0100
Subject: [PATCH] Add tuples to Scalc

---
 compiler/scalc/ast.ml        | 20 +++++++++++---------
 compiler/scalc/from_lcalc.ml | 15 +++++++++++++--
 compiler/scalc/print.ml      |  9 +++++++++
 compiler/scalc/to_python.ml  |  2 ++
 compiler/scalc/to_r.ml       |  2 ++
 5 files changed, 37 insertions(+), 11 deletions(-)

diff --git a/compiler/scalc/ast.ml b/compiler/scalc/ast.ml
index e75b2845..c28068c6 100644
--- a/compiler/scalc/ast.ml
+++ b/compiler/scalc/ast.ml
@@ -44,15 +44,17 @@ type operator =
 type expr = naked_expr Mark.pos
 
 and naked_expr =
-  | EVar : VarName.t -> naked_expr
-  | EFunc : FuncName.t -> naked_expr
-  | EStruct : expr list * StructName.t -> naked_expr
-  | EStructFieldAccess : expr * StructField.t * StructName.t -> naked_expr
-  | EInj : expr * EnumConstructor.t * EnumName.t -> naked_expr
-  | EArray : expr list -> naked_expr
-  | ELit : lit -> naked_expr
-  | EApp : expr * expr list -> naked_expr
-  | EOp : operator -> naked_expr
+  | EVar of VarName.t
+  | EFunc of FuncName.t
+  | EStruct of expr list * StructName.t
+  | EStructFieldAccess of expr * StructField.t * StructName.t
+  | ETuple of expr list
+  | ETupleAccess of expr * int
+  | EInj of expr * EnumConstructor.t * EnumName.t
+  | EArray of expr list
+  | ELit of lit
+  | EApp of expr * expr list
+  | EOp of operator
 
 type stmt =
   | SInnerFuncDef of VarName.t Mark.pos * func
diff --git a/compiler/scalc/from_lcalc.ml b/compiler/scalc/from_lcalc.ml
index 1b231006..30e779a4 100644
--- a/compiler/scalc/from_lcalc.ml
+++ b/compiler/scalc/from_lcalc.ml
@@ -57,11 +57,22 @@ let rec translate_expr (ctxt : 'm ctxt) (expr : 'm L.expr) : A.block * A.expr =
     let new_args = List.rev new_args in
     let args_stmts = List.rev args_stmts in
     args_stmts, (A.EStruct (new_args, name), Expr.pos expr)
-  | ETuple _ -> failwith "Tuples cannot be compiled to scalc"
+  | ETuple args ->
+    let args_stmts, new_args =
+      List.fold_left
+        (fun (args_stmts, new_args) arg ->
+          let arg_stmts, new_arg = translate_expr ctxt arg in
+          arg_stmts @ args_stmts, new_arg :: new_args)
+        ([], []) args
+    in
+    let new_args = List.rev new_args in
+    args_stmts, (A.ETuple new_args, Expr.pos expr)
   | EStructAccess { e = e1; field; name } ->
     let e1_stmts, new_e1 = translate_expr ctxt e1 in
     e1_stmts, (A.EStructFieldAccess (new_e1, field, name), Expr.pos expr)
-  | ETupleAccess _ -> failwith "Non-struct tuples cannot be compiled to scalc"
+  | ETupleAccess { e = e1; index; _ } ->
+    let e1_stmts, new_e1 = translate_expr ctxt e1 in
+    e1_stmts, (A.ETupleAccess (new_e1, index), Expr.pos expr)
   | EInj { e = e1; cons; name } ->
     let e1_stmts, new_e1 = translate_expr ctxt e1 in
     e1_stmts, (A.EInj (new_e1, cons, name), Expr.pos expr)
diff --git a/compiler/scalc/print.ml b/compiler/scalc/print.ml
index 24ffdb39..a930990e 100644
--- a/compiler/scalc/print.ml
+++ b/compiler/scalc/print.ml
@@ -53,6 +53,12 @@ let rec format_expr
              Print.punctuation ":" format_expr e))
       (List.combine es (StructField.Map.bindings fields))
       Print.punctuation "}"
+  | ETuple es ->
+    Format.fprintf fmt "@[<hov 2>%a%a%a@]" Print.punctuation "()"
+      (Format.pp_print_list
+         ~pp_sep:(fun fmt () -> Format.fprintf fmt ",@ ")
+         (fun fmt e -> Format.fprintf fmt "%a" format_expr e))
+      es Print.punctuation ")"
   | EArray es ->
     Format.fprintf fmt "@[<hov 2>%a%a%a@]" Print.punctuation "["
       (Format.pp_print_list
@@ -62,6 +68,9 @@ let rec format_expr
   | EStructFieldAccess (e1, field, _) ->
     Format.fprintf fmt "%a%a%a%a%a" format_expr e1 Print.punctuation "."
       Print.punctuation "\"" StructField.format field Print.punctuation "\""
+  | ETupleAccess (e1, index) ->
+    Format.fprintf fmt "%a%a%a%d%a" format_expr e1 Print.punctuation "."
+      Print.punctuation "\"" index Print.punctuation "\""
   | EInj (e, cons, _) ->
     Format.fprintf fmt "@[<hov 2>%a@ %a@]" EnumConstructor.format cons
       format_expr e
diff --git a/compiler/scalc/to_python.ml b/compiler/scalc/to_python.ml
index 67de06d6..cbd39e5a 100644
--- a/compiler/scalc/to_python.ml
+++ b/compiler/scalc/to_python.ml
@@ -384,6 +384,8 @@ let rec format_expression (ctx : decl_ctx) (fmt : Format.formatter) (e : expr) :
          (format_expression ctx))
       args
   | EOp op -> Format.fprintf fmt "%a" format_op (op, Pos.no_pos)
+  | ETuple _ | ETupleAccess _ ->
+    Message.raise_internal_error "Tuple compilation to R unimplemented!"
 
 let rec format_statement
     (ctx : decl_ctx)
diff --git a/compiler/scalc/to_r.ml b/compiler/scalc/to_r.ml
index 9d0d65d5..1c273b77 100644
--- a/compiler/scalc/to_r.ml
+++ b/compiler/scalc/to_r.ml
@@ -363,6 +363,8 @@ let rec format_expression (ctx : decl_ctx) (fmt : Format.formatter) (e : expr) :
          (format_expression ctx))
       args
   | EOp op -> Format.fprintf fmt "%a" format_op (op, Pos.no_pos)
+  | ETuple _ | ETupleAccess _ ->
+    Message.raise_internal_error "Tuple compilation to R unimplemented!"
 
 let rec format_statement
     (ctx : decl_ctx)