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 = ...@@ -231,9 +231,8 @@ and not_already_created mod_name =
* Main part * Main part
*) *)
let rec js_of_structure ?(mod_gen=[]) old_env s = let rec js_of_structure ?(mod_gen=[]) s =
let new_env = s.str_final_env in show_list_f (fun strct -> js_of_structure_item ~mod_gen strct) "@,@," s.str_items
show_list_f (fun strct -> js_of_structure_item ~mod_gen new_env strct) "@,@," s.str_items
and parse_modules ?(mod_gen=[]) = function and parse_modules ?(mod_gen=[]) = function
| [] -> [] | [] -> []
...@@ -245,17 +244,16 @@ and parse_modules ?(mod_gen=[]) = function ...@@ -245,17 +244,16 @@ and parse_modules ?(mod_gen=[]) = function
| None -> failwith ("Could not read and typecheck " ^ inputfile) | None -> failwith ("Could not read and typecheck " ^ inputfile)
| Some (parsetree1, (typedtree1, _)) -> parsetree1, typedtree1 | Some (parsetree1, (typedtree1, _)) -> parsetree1, typedtree1
in 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 Printf.sprintf "%s = {\n%s\n}" name pre :: parse_modules ~mod_gen xs
and show_value_binding ?(mod_gen=[]) vb = and show_value_binding ?(mod_gen=[]) vb =
js_of_let_pattern ~mod_gen vb.vb_pat vb.vb_expr js_of_let_pattern ~mod_gen vb.vb_pat vb.vb_expr
and js_of_structure_item ?(mod_gen=[]) old_env s = and js_of_structure_item ?(mod_gen=[]) s =
let new_env = s.str_env in
let loc = s.str_loc in let loc = s.str_loc in
match s.str_desc with 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_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_type tl -> "" (* Types have no representation in JS, but the OCaml type checker uses them *)
| Tstr_open od -> | Tstr_open od ->
...@@ -286,9 +284,9 @@ and js_of_structure_item ?(mod_gen=[]) old_env s = ...@@ -286,9 +284,9 @@ and js_of_structure_item ?(mod_gen=[]) old_env s =
| Tstr_include _ -> out_of_scope loc "includes" | Tstr_include _ -> out_of_scope loc "includes"
| Tstr_attribute attrs -> out_of_scope loc "attributes" | 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 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 if binders = "" then ppf_branch spat binders se
else else
let typ = match List.rev (Str.split (Str.regexp " ") spat) with 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 = ...@@ -296,15 +294,14 @@ and js_of_branch ?(mod_gen=[]) old_env b obj =
| x :: xs -> String.sub x 0 (String.length x) | x :: xs -> String.sub x 0 (String.length x)
in L.log_line (ppf_branch spat binders se) (L.Add (binders, typ)) 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 locn = e.exp_loc in
let new_env = e.exp_env in
match e.exp_desc with match e.exp_desc with
| Texp_ident (_, loc, _) -> js_of_longident loc | Texp_ident (_, loc, _) -> js_of_longident loc
| Texp_constant c -> js_of_constant c | Texp_constant c -> js_of_constant c
| Texp_let (_, vb_l, e) -> | Texp_let (_, vb_l, e) ->
let sd = String.concat lin1 @@ List.map (fun vb -> show_value_binding ~mod_gen vb) @@ vb_l in 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 in ppf_let_in sd se
| Texp_function (_, c :: [], Total) -> | Texp_function (_, c :: [], Total) ->
let rec explore pats e = match e.exp_desc with let rec explore pats e = match e.exp_desc with
...@@ -312,25 +309,25 @@ and js_of_expression ?(mod_gen=[]) old_env e = ...@@ -312,25 +309,25 @@ and js_of_expression ?(mod_gen=[]) old_env e =
let p, e = c.c_lhs, c.c_rhs let p, e = c.c_lhs, c.c_rhs
in explore (p :: pats) e 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 let args, body = explore [c.c_lhs] c.c_rhs
in ppf_function args body in ppf_function args body
| Texp_apply (f, exp_l) -> | Texp_apply (f, exp_l) ->
let sl' = 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 |> List.map (fun (_, eo, _) -> match eo with None -> out_of_scope locn "optional apply arguments" | Some ei -> ei) in
let sl = exp_l 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 |> 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 new_env f in let se = js_of_expression ~mod_gen f in
if is_infix f sl' && List.length exp_l = 2 if is_infix f sl' && List.length exp_l = 2
then ppf_apply_infix se (List.hd sl) (List.hd (List.tl sl)) then ppf_apply_infix se (List.hd sl) (List.hd (List.tl sl))
else ppf_apply se (String.concat ", " sl) else ppf_apply se (String.concat ", " sl)
| Texp_match (exp, l, [], Total) -> | Texp_match (exp, l, [], Total) ->
let se = js_of_expression ~mod_gen new_env exp in let se = js_of_expression ~mod_gen exp in
let sb = String.concat "@," (List.map (fun x -> js_of_branch ~mod_gen old_env x se) l) in let sb = String.concat "@," (List.map (fun x -> js_of_branch ~mod_gen x se) l) in
ppf_match se sb 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) -> | Texp_construct (loc, cd, el) ->
let name = cd.cstr_name in let name = cd.cstr_name in
...@@ -339,20 +336,20 @@ and js_of_expression ?(mod_gen=[]) old_env e = ...@@ -339,20 +336,20 @@ and js_of_expression ?(mod_gen=[]) old_env e =
else ppf_single_cstrs name else ppf_single_cstrs name
else (* Constructor has parameters *) else (* Constructor has parameters *)
let fields = extract_attrs cd.cstr_attributes in 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 expand_constructor_list = List.map2 ppf_cstr in
let expanded_constructors = expand_constructor_list fields expr_strs in let expanded_constructors = expand_constructor_list fields expr_strs in
ppf_multiple_cstrs name (show_list ", " expanded_constructors) 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_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 new_env e1) (js_of_expression ~mod_gen new_env e2) | 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 new_env e1) (js_of_expression ~mod_gen new_env e2) (js_of_expression ~mod_gen new_env e3) | 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 new_env e1) (js_of_expression ~mod_gen new_env e2) | 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 new_env cd) (js_of_expression ~mod_gen new_env body) | 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 new_env st) (js_of_expression ~mod_gen new_env ed) fl (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 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 new_env exp)) llde) | Texp_record (llde,_) -> ppf_record (List.map (fun (_, lbl, exp) -> (lbl.lbl_name, js_of_expression ~mod_gen exp)) llde)
| Texp_field (exp, _, lbl) -> | 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 (_,_,_, Partial) -> out_of_scope locn "partial matching"
| Texp_match (_,_,_,_) -> out_of_scope locn "matching with exception branches" | Texp_match (_,_,_,_) -> out_of_scope locn "matching with exception branches"
...@@ -389,8 +386,7 @@ and ident_of_pat pat = match pat.pat_desc with ...@@ -389,8 +386,7 @@ and ident_of_pat pat = match pat.pat_desc with
| _ -> error ~loc:pat.pat_loc "functions can't deconstruct values" | _ -> error ~loc:pat.pat_loc "functions can't deconstruct values"
and js_of_let_pattern ?(mod_gen=[]) pat expr = and js_of_let_pattern ?(mod_gen=[]) pat expr =
let new_env = pat.pat_env in let sexpr = js_of_expression ~mod_gen expr in
let sexpr = js_of_expression ~mod_gen new_env expr in
match pat.pat_desc with match pat.pat_desc with
| Tpat_var (id, _) -> ppf_decl ~mod_gen (Ident.name id) sexpr | Tpat_var (id, _) -> ppf_decl ~mod_gen (Ident.name id) sexpr
| Tpat_tuple (pat_l) | Tpat_tuple (pat_l)
...@@ -428,7 +424,7 @@ and js_of_pattern ?(mod_gen=[]) pat obj = ...@@ -428,7 +424,7 @@ and js_of_pattern ?(mod_gen=[]) pat obj =
| Tpat_lazy _ -> out_of_scope locn "lazy-pattern" | Tpat_lazy _ -> out_of_scope locn "lazy-pattern"
let to_javascript typedtree = 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 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), let logged, unlogged, pre = L.logged_output (mod_code ^ "\n" ^ pre_res),
L.unlogged_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