Add tuples to Scalc

This commit is contained in:
Denis Merigoux 2023-11-28 14:14:26 +01:00 committed by Denis Merigoux
parent 6652dc8df2
commit 5f045110b9
No known key found for this signature in database
GPG Key ID: EE99DCFA365C3EE3
5 changed files with 37 additions and 11 deletions

View File

@ -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

View File

@ -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)

View File

@ -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

View File

@ -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)

View File

@ -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)