Skip to content
Snippets Groups Projects
Commit fdab2f36 authored by Alan Schmitt's avatar Alan Schmitt
Browse files

Merge branch 'newctx' of github.com:resource-reasoning/jscert_dev into newctx

parents 18b86cf6 d9a09c3e
No related branches found
No related tags found
No related merge requests found
......@@ -428,6 +428,7 @@ and js_of_expression_wrapped ctx e = (* dest = Dest_return *)
ppf_lambda_wrap (js_of_expression ctx Dest_return e)
and js_of_expression ctx dest e =
let inline_of_wrap = js_of_expression_inline_or_wrap ctx in (* shorthand *)
let loc = e.exp_loc in
match e.exp_desc with
......@@ -472,8 +473,8 @@ and js_of_expression ctx dest e =
|> List.map (fun (_, eo, _) -> match eo with
| None -> out_of_scope loc "optional apply arguments"
| Some ei -> ei) in
let sl = sl_clean |> List.map (fun ei -> js_of_expression_inline_or_wrap ctx ei) in
let se = js_of_expression_inline_or_wrap ctx f in
let sl = sl_clean |> List.map (fun ei -> inline_of_wrap ei) in
let se = inline_of_wrap f in
let sexp =
if is_infix f sl' && List.length exp_l = 2
then ppf_apply_infix se (List.hd sl) (List.hd (List.tl sl))
......@@ -498,7 +499,7 @@ and js_of_expression ctx dest e =
apply_dest ctx dest sexp
| Texp_tuple (tl) ->
let sexp = ppf_tuple @@ show_list_f (fun exp -> js_of_expression_inline_or_wrap ctx exp) ", " tl in
let sexp = ppf_tuple @@ show_list_f (fun exp -> inline_of_wrap exp) ", " tl in
apply_dest ctx dest sexp
| Texp_construct (_, cd, el) ->
......@@ -508,23 +509,27 @@ and js_of_expression ctx dest e =
if is_sbool name then name (* Special case true/false to their JS natives *)
else ppf_single_cstrs name
else (* Constructor has parameters *)
let expr_strs = List.map (fun exp -> js_of_expression_inline_or_wrap ctx exp) el in
let expr_strs = List.map (fun exp -> inline_of_wrap exp) el in
let expanded_constructors = map_cstr_fields ~loc ppf_cstr cd expr_strs in
ppf_multiple_cstrs name (show_list ", " expanded_constructors)
in
apply_dest ctx dest sexp
(*
| Texp_array (exp_l) -> ppf_array @@ show_list_f (fun exp -> js_of_expression exp) ", " exp_l
| Texp_ifthenelse (e1, e2, None) -> ppf_ifthen (js_of_expression e1) (js_of_expression e2)
| Texp_ifthenelse (e1, e2, Some e3) -> ppf_ifthenelse (js_of_expression e1) (js_of_expression e2) (js_of_expression e3)
| Texp_sequence (e1, e2) -> ppf_sequence (js_of_expression e1) (js_of_expression e2)
| Texp_while (cd, body) -> ppf_while (js_of_expression cd) (js_of_expression body)
| Texp_for (id, _, st, ed, fl, body) -> ppf_for (ppf_ident id) (js_of_expression st) (js_of_expression ed) fl (js_of_expression body)
| Texp_record (llde,_) -> ppf_record (List.map (fun (_, lbl, exp) -> (lbl.lbl_name, js_of_expression exp)) llde)
| Texp_field (exp, _, lbl) ->
ppf_field_access (js_of_expression exp) lbl.lbl_name
*)
| Texp_array (exp_l) -> ppf_array @@ show_list_f (fun exp -> inline_of_wrap exp) ", " exp_l
| Texp_ifthenelse (e1, e2, None) -> out_of_scope loc "if without else"
(* ppf_ifthen (js_of_expression e1) (js_of_expression e2) *)
| Texp_ifthenelse (e1, e2, Some e3) ->
reject_inline dest;
ppf_ifthenelse (inline_of_wrap e1) (js_of_expression ctx dest e2) (js_of_expression ctx dest e3)
| Texp_sequence (e1, e2) -> out_of_scope loc "sequence"
(* ppf_sequence (js_of_expression e1) (js_of_expression e2) *)
| Texp_while (cd, body) -> out_of_scope loc "while"
(* ppf_while (js_of_expression cd) (js_of_expression body) *)
| Texp_for (id, _, st, ed, fl, body) -> out_of_scope loc "for"
(* ppf_for (ppf_ident id) (js_of_expression st) (js_of_expression ed) fl (js_of_expression body) *)
| Texp_record (llde,_) -> ppf_record (List.map (fun (_, lbl, exp) -> (lbl.lbl_name, inline_of_wrap exp)) llde)
| Texp_field (exp, _, lbl) -> ppf_field_access (inline_of_wrap exp) lbl.lbl_name
| Texp_match (_,_,_, Partial) -> out_of_scope loc "partial matching"
| Texp_match (_,_,_,_) -> out_of_scope loc "matching with exception branches"
| Texp_try (_,_) -> out_of_scope loc "exceptions"
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment