mirror of
https://github.com/CatalaLang/catala.git
synced 2024-11-08 07:51:43 +03:00
Add tuples to Scalc
This commit is contained in:
parent
6652dc8df2
commit
5f045110b9
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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)
|
||||
|
Loading…
Reference in New Issue
Block a user