Add tuples to Scalc

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

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)

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

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)

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)