Factor out some trans bits.
This commit is contained in:
parent
1c60be2f32
commit
c483808e0f
1 changed files with 44 additions and 42 deletions
|
@ -2041,9 +2041,12 @@ let trans_visitor
|
||||||
|];
|
|];
|
||||||
List.iter patch fwd_jmps
|
List.iter patch fwd_jmps
|
||||||
|
|
||||||
and trans_check_expr (e:Ast.expr) : unit =
|
and trans_check_expr (id:node_id) (e:Ast.expr) : unit =
|
||||||
let fwd_jmps = trans_cond false e in
|
match expr_type cx e with
|
||||||
trans_cond_fail (Fmt.fmt_to_str Ast.fmt_expr e) fwd_jmps
|
Ast.TY_bool ->
|
||||||
|
let fwd_jmps = trans_cond false e in
|
||||||
|
trans_cond_fail (Fmt.fmt_to_str Ast.fmt_expr e) fwd_jmps
|
||||||
|
| _ -> bugi cx id "check expr on non-bool"
|
||||||
|
|
||||||
and trans_malloc (dst:Il.cell) (nbytes:Il.operand) : unit =
|
and trans_malloc (dst:Il.cell) (nbytes:Il.operand) : unit =
|
||||||
trans_upcall "upcall_malloc" dst [| nbytes |]
|
trans_upcall "upcall_malloc" dst [| nbytes |]
|
||||||
|
@ -4062,31 +4065,50 @@ let trans_visitor
|
||||||
emit (Il.binary op dst_cell (Il.Cell dst_cell) src_oper);
|
emit (Il.binary op dst_cell (Il.Cell dst_cell) src_oper);
|
||||||
|
|
||||||
|
|
||||||
|
and trans_call id dst flv args =
|
||||||
|
let init = maybe_init id "call" dst in
|
||||||
|
let ty = lval_ty cx flv in
|
||||||
|
let ty_params =
|
||||||
|
match
|
||||||
|
htab_search
|
||||||
|
cx.ctxt_call_lval_params (lval_base_id flv)
|
||||||
|
with
|
||||||
|
Some params -> params
|
||||||
|
| None -> [| |]
|
||||||
|
in
|
||||||
|
match ty with
|
||||||
|
Ast.TY_fn _ ->
|
||||||
|
let (dst_cell, _) = trans_lval_maybe_init init dst in
|
||||||
|
let fn_ptr =
|
||||||
|
trans_prepare_fn_call init cx dst_cell flv
|
||||||
|
ty_params None args
|
||||||
|
in
|
||||||
|
call_code (code_of_operand fn_ptr)
|
||||||
|
| _ -> bug () "Calling unexpected lval."
|
||||||
|
|
||||||
|
|
||||||
|
and trans_log id a =
|
||||||
|
match atom_type cx a with
|
||||||
|
(* NB: If you extend this, be sure to update the
|
||||||
|
* typechecking code in type.ml as well. *)
|
||||||
|
Ast.TY_str -> trans_log_str a
|
||||||
|
| Ast.TY_int | Ast.TY_uint | Ast.TY_bool
|
||||||
|
| Ast.TY_char | Ast.TY_mach (TY_u8)
|
||||||
|
| Ast.TY_mach (TY_u16) | Ast.TY_mach (TY_u32)
|
||||||
|
| Ast.TY_mach (TY_i8) | Ast.TY_mach (TY_i16)
|
||||||
|
| Ast.TY_mach (TY_i32) ->
|
||||||
|
trans_log_int a
|
||||||
|
| _ -> bugi cx id "unimplemented logging type"
|
||||||
|
|
||||||
|
|
||||||
and trans_stmt_full (stmt:Ast.stmt) : unit =
|
and trans_stmt_full (stmt:Ast.stmt) : unit =
|
||||||
match stmt.node with
|
match stmt.node with
|
||||||
|
|
||||||
Ast.STMT_log a ->
|
Ast.STMT_log a ->
|
||||||
begin
|
trans_log stmt.id a
|
||||||
match atom_type cx a with
|
|
||||||
(* NB: If you extend this, be sure to update the
|
|
||||||
* typechecking code in type.ml as well. *)
|
|
||||||
Ast.TY_str -> trans_log_str a
|
|
||||||
| Ast.TY_int | Ast.TY_uint | Ast.TY_bool
|
|
||||||
| Ast.TY_char | Ast.TY_mach (TY_u8)
|
|
||||||
| Ast.TY_mach (TY_u16) | Ast.TY_mach (TY_u32)
|
|
||||||
| Ast.TY_mach (TY_i8) | Ast.TY_mach (TY_i16)
|
|
||||||
| Ast.TY_mach (TY_i32) ->
|
|
||||||
trans_log_int a
|
|
||||||
| _ -> bugi cx stmt.id "unimplemented logging type"
|
|
||||||
end
|
|
||||||
|
|
||||||
| Ast.STMT_check_expr e ->
|
| Ast.STMT_check_expr e ->
|
||||||
begin
|
trans_check_expr stmt.id e
|
||||||
match expr_type cx e with
|
|
||||||
Ast.TY_bool -> trans_check_expr e
|
|
||||||
| _ -> bugi cx stmt.id "check expr on non-bool"
|
|
||||||
end
|
|
||||||
|
|
||||||
| Ast.STMT_yield ->
|
| Ast.STMT_yield ->
|
||||||
trans_yield ()
|
trans_yield ()
|
||||||
|
@ -4113,27 +4135,7 @@ let trans_visitor
|
||||||
trans_copy_binop dst binop a_src
|
trans_copy_binop dst binop a_src
|
||||||
|
|
||||||
| Ast.STMT_call (dst, flv, args) ->
|
| Ast.STMT_call (dst, flv, args) ->
|
||||||
begin
|
trans_call stmt.id dst flv args
|
||||||
let init = maybe_init stmt.id "call" dst in
|
|
||||||
let ty = lval_ty cx flv in
|
|
||||||
let ty_params =
|
|
||||||
match
|
|
||||||
htab_search
|
|
||||||
cx.ctxt_call_lval_params (lval_base_id flv)
|
|
||||||
with
|
|
||||||
Some params -> params
|
|
||||||
| None -> [| |]
|
|
||||||
in
|
|
||||||
match ty with
|
|
||||||
Ast.TY_fn _ ->
|
|
||||||
let (dst_cell, _) = trans_lval_maybe_init init dst in
|
|
||||||
let fn_ptr =
|
|
||||||
trans_prepare_fn_call init cx dst_cell flv
|
|
||||||
ty_params None args
|
|
||||||
in
|
|
||||||
call_code (code_of_operand fn_ptr)
|
|
||||||
| _ -> bug () "Calling unexpected lval."
|
|
||||||
end
|
|
||||||
|
|
||||||
| Ast.STMT_bind (dst, flv, args) ->
|
| Ast.STMT_bind (dst, flv, args) ->
|
||||||
begin
|
begin
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue