Skip to content
Snippets Groups Projects
Commit 973d65c1 authored by Thomas Wood's avatar Thomas Wood
Browse files

Remove superfluous env parameters from js_of_ast 

We don't actually make use of the env at all in the recursive js_of_ast
function. It's also present as part of the tree structure we're
recursing over, so completely superfluous anyway.
parent 45769002
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
Showing
with 26 additions and 30 deletions
generator/js_of_ast.ml
+ 26
− 30
View file @ 973d65c1
......@@ -231,9 +231,8 @@ and not_already_created mod_name =
* Main part
*)
let rec js_of_structure ?(mod_gen=[]) old_env s =
let new_env = s.str_final_env in
show_list_f (fun strct -> js_of_structure_item ~mod_gen new_env strct) "@,@," s.str_items
let rec js_of_structure ?(mod_gen=[]) s =
show_list_f (fun strct -> js_of_structure_item ~mod_gen strct) "@,@," s.str_items
and parse_modules ?(mod_gen=[]) = function
| [] -> []
......@@ -245,17 +244,16 @@ and parse_modules ?(mod_gen=[]) = function
| None -> failwith ("Could not read and typecheck " ^ inputfile)
| Some (parsetree1, (typedtree1, _)) -> parsetree1, typedtree1
in
let pre = js_of_structure ~mod_gen:(name :: mod_gen) Env.empty typedtree1 in
let pre = js_of_structure ~mod_gen:(name :: mod_gen) typedtree1 in
Printf.sprintf "%s = {\n%s\n}" name pre :: parse_modules ~mod_gen xs
and show_value_binding ?(mod_gen=[]) vb =
js_of_let_pattern ~mod_gen vb.vb_pat vb.vb_expr
and js_of_structure_item ?(mod_gen=[]) old_env s =
let new_env = s.str_env in
and js_of_structure_item ?(mod_gen=[]) s =
let loc = s.str_loc in
match s.str_desc with
| Tstr_eval (e, _) -> Printf.sprintf "%s" @@ js_of_expression ~mod_gen new_env e
| Tstr_eval (e, _) -> Printf.sprintf "%s" @@ js_of_expression ~mod_gen e
| Tstr_value (_, vb_l) -> String.concat "@,@," @@ List.map (fun vb -> show_value_binding ~mod_gen vb) @@ vb_l
| Tstr_type tl -> "" (* Types have no representation in JS, but the OCaml type checker uses them *)
| Tstr_open od ->
......@@ -286,9 +284,9 @@ and js_of_structure_item ?(mod_gen=[]) old_env s =
| Tstr_include _ -> out_of_scope loc "includes"
| Tstr_attribute attrs -> out_of_scope loc "attributes"
and js_of_branch ?(mod_gen=[]) old_env b obj =
and js_of_branch ?(mod_gen=[]) b obj =
let spat, binders = js_of_pattern ~mod_gen b.c_lhs obj in
let se = js_of_expression ~mod_gen old_env b.c_rhs in
let se = js_of_expression ~mod_gen b.c_rhs in
if binders = "" then ppf_branch spat binders se
else
let typ = match List.rev (Str.split (Str.regexp " ") spat) with
......@@ -296,15 +294,14 @@ and js_of_branch ?(mod_gen=[]) old_env b obj =
| x :: xs -> String.sub x 0 (String.length x)
in L.log_line (ppf_branch spat binders se) (L.Add (binders, typ))
and js_of_expression ?(mod_gen=[]) old_env e =
and js_of_expression ?(mod_gen=[]) e =
let locn = e.exp_loc in
let new_env = e.exp_env in
match e.exp_desc with
| Texp_ident (_, loc, _) -> js_of_longident loc
| Texp_constant c -> js_of_constant c
| Texp_let (_, vb_l, e) ->
let sd = String.concat lin1 @@ List.map (fun vb -> show_value_binding ~mod_gen vb) @@ vb_l in
let se = js_of_expression ~mod_gen new_env e
let se = js_of_expression ~mod_gen e
in ppf_let_in sd se
| Texp_function (_, c :: [], Total) ->
let rec explore pats e = match e.exp_desc with
......@@ -312,25 +309,25 @@ and js_of_expression ?(mod_gen=[]) old_env e =
let p, e = c.c_lhs, c.c_rhs
in explore (p :: pats) e
| _ ->
String.concat ", " @@ List.map ident_of_pat @@ List.rev @@ pats, js_of_expression ~mod_gen new_env e in
String.concat ", " @@ List.map ident_of_pat @@ List.rev @@ pats, js_of_expression ~mod_gen e in
let args, body = explore [c.c_lhs] c.c_rhs
in ppf_function args body
| Texp_apply (f, exp_l) ->
let sl' = exp_l
|> List.map (fun (_, eo, _) -> match eo with None -> out_of_scope locn "optional apply arguments" | Some ei -> ei) in
let sl = exp_l
|> List.map (fun (_, eo, _) -> match eo with None -> out_of_scope locn "optional apply arguments" | Some ei -> js_of_expression ~mod_gen new_env ei) in
let se = js_of_expression ~mod_gen new_env f in
|> List.map (fun (_, eo, _) -> match eo with None -> out_of_scope locn "optional apply arguments" | Some ei -> js_of_expression ~mod_gen ei) in
let se = js_of_expression ~mod_gen f in
if is_infix f sl' && List.length exp_l = 2
then ppf_apply_infix se (List.hd sl) (List.hd (List.tl sl))
else ppf_apply se (String.concat ", " sl)
| Texp_match (exp, l, [], Total) ->
let se = js_of_expression ~mod_gen new_env exp in
let sb = String.concat "@," (List.map (fun x -> js_of_branch ~mod_gen old_env x se) l) in
let se = js_of_expression ~mod_gen exp in
let sb = String.concat "@," (List.map (fun x -> js_of_branch ~mod_gen x se) l) in
ppf_match se sb
| Texp_tuple (tl) -> ppf_tuple @@ show_list_f (fun exp -> js_of_expression ~mod_gen new_env exp) ", " tl
| Texp_tuple (tl) -> ppf_tuple @@ show_list_f (fun exp -> js_of_expression ~mod_gen exp) ", " tl
| Texp_construct (loc, cd, el) ->
let name = cd.cstr_name in
......@@ -339,20 +336,20 @@ and js_of_expression ?(mod_gen=[]) old_env e =
else ppf_single_cstrs name
else (* Constructor has parameters *)
let fields = extract_attrs cd.cstr_attributes in
let expr_strs = List.map (fun exp -> js_of_expression ~mod_gen new_env exp) el in
let expr_strs = List.map (fun exp -> js_of_expression ~mod_gen exp) el in
let expand_constructor_list = List.map2 ppf_cstr in
let expanded_constructors = expand_constructor_list fields expr_strs in
ppf_multiple_cstrs name (show_list ", " expanded_constructors)
| Texp_array (exp_l) -> ppf_array @@ show_list_f (fun exp -> js_of_expression ~mod_gen new_env exp) ", " exp_l
| Texp_ifthenelse (e1, e2, None) -> ppf_ifthen (js_of_expression ~mod_gen new_env e1) (js_of_expression ~mod_gen new_env e2)
| Texp_ifthenelse (e1, e2, Some e3) -> ppf_ifthenelse (js_of_expression ~mod_gen new_env e1) (js_of_expression ~mod_gen new_env e2) (js_of_expression ~mod_gen new_env e3)
| Texp_sequence (e1, e2) -> ppf_sequence (js_of_expression ~mod_gen new_env e1) (js_of_expression ~mod_gen new_env e2)
| Texp_while (cd, body) -> ppf_while (js_of_expression ~mod_gen new_env cd) (js_of_expression ~mod_gen new_env body)
| Texp_for (id, _, st, ed, fl, body) -> ppf_for (Ident.name id) (js_of_expression ~mod_gen new_env st) (js_of_expression ~mod_gen new_env ed) fl (js_of_expression ~mod_gen new_env body)
| Texp_record (llde,_) -> ppf_record (List.map (fun (_, lbl, exp) -> (lbl.lbl_name, js_of_expression ~mod_gen new_env exp)) llde)
| Texp_array (exp_l) -> ppf_array @@ show_list_f (fun exp -> js_of_expression ~mod_gen exp) ", " exp_l
| Texp_ifthenelse (e1, e2, None) -> ppf_ifthen (js_of_expression ~mod_gen e1) (js_of_expression ~mod_gen e2)
| Texp_ifthenelse (e1, e2, Some e3) -> ppf_ifthenelse (js_of_expression ~mod_gen e1) (js_of_expression ~mod_gen e2) (js_of_expression ~mod_gen e3)
| Texp_sequence (e1, e2) -> ppf_sequence (js_of_expression ~mod_gen e1) (js_of_expression ~mod_gen e2)
| Texp_while (cd, body) -> ppf_while (js_of_expression ~mod_gen cd) (js_of_expression ~mod_gen body)
| Texp_for (id, _, st, ed, fl, body) -> ppf_for (Ident.name id) (js_of_expression ~mod_gen st) (js_of_expression ~mod_gen ed) fl (js_of_expression ~mod_gen body)
| Texp_record (llde,_) -> ppf_record (List.map (fun (_, lbl, exp) -> (lbl.lbl_name, js_of_expression ~mod_gen exp)) llde)
| Texp_field (exp, _, lbl) ->
ppf_field_access (js_of_expression ~mod_gen new_env exp) lbl.lbl_name
ppf_field_access (js_of_expression ~mod_gen exp) lbl.lbl_name
| Texp_match (_,_,_, Partial) -> out_of_scope locn "partial matching"
| Texp_match (_,_,_,_) -> out_of_scope locn "matching with exception branches"
......@@ -389,8 +386,7 @@ and ident_of_pat pat = match pat.pat_desc with
| _ -> error ~loc:pat.pat_loc "functions can't deconstruct values"
and js_of_let_pattern ?(mod_gen=[]) pat expr =
let new_env = pat.pat_env in
let sexpr = js_of_expression ~mod_gen new_env expr in
let sexpr = js_of_expression ~mod_gen expr in
match pat.pat_desc with
| Tpat_var (id, _) -> ppf_decl ~mod_gen (Ident.name id) sexpr
| Tpat_tuple (pat_l)
......@@ -428,7 +424,7 @@ and js_of_pattern ?(mod_gen=[]) pat obj =
| Tpat_lazy _ -> out_of_scope locn "lazy-pattern"
let to_javascript typedtree =
let pre_res = js_of_structure Env.empty typedtree in
let pre_res = js_of_structure typedtree in
let mod_code = String.concat "\n\n" (List.map L.strip_log_info !module_code) in
let logged, unlogged, pre = L.logged_output (mod_code ^ "\n" ^ pre_res),
L.unlogged_output (mod_code ^ "\n" ^ pre_res),
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment