diff --git a/generator/Makefile b/generator/Makefile index c24823f7a420c8cf3af22a5950f74d26514a8685..212ed532f60b80662acb9ce0aeabf9516d796621 100644 --- a/generator/Makefile +++ b/generator/Makefile @@ -28,6 +28,7 @@ debug: main.d.byte native: _tags $(OCAMLBUILD) main.native + stdlib: $(CC) stdlib_ml/stdlib.mli @@ -118,6 +119,16 @@ arthur: $(ML_JSREF:.ml=.log.js) $(ML_JSREF:.ml=.unlog.js) $(ML_JSREF:.ml=.token. # tests/jsref/JsInterpreter.log.js +######### lineof target ######### + +tests/jsref/lineof.js: lineof.byte $(ML_JSREF:.ml=.token.js) + lineof.byte -o $@ $(ML_JSREF:.ml=.token.js) + +lineof: tests/jsref/lineof.js + +################## + + clean_stdlib: rm -f $(STD_DIR)/*.cmi @@ -141,22 +152,12 @@ cleanall: clean clean_cmi ifeq ($(filter clean%,$(MAKECMDGOALS)),) -include $(ML_TESTS:.ml=.ml.d) -endif - -#ifeq ($(MAKECMDGOALS),tests/lambda) -ifneq ($(findstring tests/lambda,$(MAKECMDGOALS)),) --include $(ML_LAMBDA:.ml=.ml.d) -endif - -#tests/ -ifneq ($(findstring jsref,$(MAKECMDGOALS)),) -#$(error $(ML_JSREF:.ml=.ml.d)) -include $(ML_JSREF:.ml=.ml.d) -include $(MLI_JSREF:.mli=.mli.d) endif -ifneq ($(findstring a,$(MAKECMDGOALS)),) -#$(error $(ML_JSREF:.ml=.ml.d)) --include $(ML_JSREF:.ml=.ml.d) --include $(MLI_JSREF:.mli=.mli.d) -endif + +#ifeq ($(findstring clean,$(MAKECMDGOALS)),) +#-include $(ML_JSREF:.ml=.ml.d) +#-include $(MLI_JSREF:.mli=.mli.d) +#endif diff --git a/generator/TODO b/generator/TODO index 8f32804dde132124a40f411b239241a56048fae3..8c17a1ffe09c147f3fddcff731e92e55639f1e80 100644 --- a/generator/TODO +++ b/generator/TODO @@ -43,4 +43,22 @@ LATER - => binder qq part vers une comparaison --- dans un fichier js _compare_JsSyntax_native_error - _compare_JsSyntax_prealloc \ No newline at end of file + _compare_JsSyntax_prealloc + + + +========== + +TODO: demo of double clicking goes to the right page in ecma in english + +TODO: interpretation of comparison function in the search by "predicate" + might want to automatically "lift" basic values to their encoding + (unless some box is checked to prevent this behavior) + + example: "x == 3" means: + "similar(x, { type: "value", tag: "value_prim", value: { type: "prim", tag: "float", value: 3.0 } })". + + where similar is a recursive structural comparison function (not going through the heap) + + +========== diff --git a/generator/js_of_ast.ml b/generator/js_of_ast.ml index 8bddb3e2499e6d1bc772d9d56f5ee15aba0159f7..14601c49b4dabd5e0201dcf327cd6524c96b03f9 100644 --- a/generator/js_of_ast.ml +++ b/generator/js_of_ast.ml @@ -248,10 +248,9 @@ let ppf_path = let ppf_module content = Printf.sprintf "{@,%s@,}" content -let ppf_module_wrap name content = - let modu = ppf_module content in - Printf.sprintf "var %s = %s;" name modu - +let ppf_module_wrap name content names_bound = + let bindings = show_list ", " (List.map (fun id -> Printf.sprintf "@\n %s: %s" id id) names_bound) in + Printf.sprintf "var %s = (function() {@,@, %s @,@,@\nreturn {@\n %s };@,@\n})();@," name content bindings @@ -472,13 +471,22 @@ let reject_inline dest = (****************************************************************) (* TRANSLATION *) +(* takes a list of pairs made of: list of strings, and list of strings, + and return a pair of a string (the string concat with newlines of the fst strings), + and a list of strings (the list flatten of the snd strings) *) + +let combine_list_output args = + let (strs,bss) = List.split args in + (show_list "@,@," strs), (List.flatten bss) + let rec js_of_structure s = - show_list_f (fun strct -> js_of_structure_item strct) "@,@," s.str_items + combine_list_output (List.map (fun strct -> js_of_structure_item strct) s.str_items) and js_of_submodule m = + Printf.printf "warning: code generation is incorrect for local modules\n"; let loc = m.mod_loc in match m.mod_desc with - | Tmod_structure s -> ppf_module (js_of_structure s) + | Tmod_structure s -> ppf_module (fst (*TODO*) (js_of_structure s)) | Tmod_functor (id, _, mtyp, mexp) -> ppf_function (ppf_ident id) (js_of_submodule mexp) | Tmod_apply (m1, m2, _) -> ppf_apply (js_of_submodule m1) (js_of_submodule m2) | Tmod_ident (p,_) -> ppf_path p @@ -491,31 +499,38 @@ and show_value_binding ctx vb = (* dest is Ignore *) and js_of_structure_item s = let loc = s.str_loc in match s.str_desc with - | Tstr_eval (e, _) -> Printf.sprintf "%s" @@ js_of_expression ctx_initial Dest_ignore e - | Tstr_value (_, vb_l) -> String.concat "@,@," @@ List.map (fun vb -> - (* let (id, sdecl) = show_value_binding ctx_initial vb in *) - Printf.sprintf "@\n@\n%s: %s," (ident_of_pat vb.vb_pat) (js_of_expression_inline_or_wrap ctx_initial vb.vb_expr)) - @@ vb_l + | Tstr_eval (e, _) -> + let str = Printf.sprintf "%s" @@ js_of_expression ctx_initial Dest_ignore e in + (str, []) + | Tstr_value (_, vb_l) -> + combine_list_output (~~ List.map vb_l (fun vb -> + let id = ident_of_pat vb.vb_pat in + let sbody = js_of_expression_inline_or_wrap ctx_initial vb.vb_expr in + let s = Printf.sprintf "@\n@\n var %s = %s;" id sbody in + (s, [id]))) | Tstr_type decls -> - (* function id( f1, f2) { return { typ: t, tag: x, "f1": f1, "f2": f2 } } *) - String.concat "@,@," @@ (List.map (fun decl -> + combine_list_output (~~ List.map decls (fun decl -> match decl.typ_type.type_kind with | Type_variant cstr_decls -> let styp = decl.typ_name.txt in - String.concat "@,@," @@ (List.map (fun (cd:Types.constructor_declaration) -> + combine_list_output (~~ List.map cstr_decls (fun (cd:Types.constructor_declaration) -> let cstr_name = cd.Types.cd_id.Ident.name in let fields = extract_cstr_attrs_basic cstr_name cd.cd_attributes in let sargs = show_list ", " fields in let sbindings = map_filter_fields_elements ppf_cstr fields fields in let rest = show_list ", " sbindings in let sobj = ppf_cstrs styp cstr_name rest in - Printf.sprintf "function %s(%s) { return %s; }" cstr_name sargs sobj)) - @@ cstr_decls - | _ -> "")) - @@ decls - | Tstr_open _ -> "" (* Handle modules by use of multiple compilation/linking *) - | Tstr_modtype _ -> "" - | Tstr_module b -> ppf_decl (ppf_ident b.mb_id) (js_of_submodule b.mb_expr) + let sbody = Printf.sprintf "function %s(%s) { return %s; }" cstr_name sargs sobj in + (sbody, [cstr_name]) + )) + | _ -> ("", []) + )) + | Tstr_open _ -> ("",[]) (* Handle modules by use of multiple compilation/linking *) + | Tstr_modtype _ -> ("",[]) + | Tstr_module b -> + let id = ppf_ident b.mb_id in + let sbody = ppf_decl id (js_of_submodule b.mb_expr) in + (sbody, [id]) | Tstr_primitive _ -> out_of_scope loc "primitive functions" | Tstr_typext _ -> out_of_scope loc "type extensions" | Tstr_exception _ -> out_of_scope loc "exceptions" @@ -832,8 +847,8 @@ and js_of_pattern pat obj = let to_javascript basename module_name typedtree = token_register_basename basename; - let content = js_of_structure typedtree in - let pre_res = ppf_module_wrap module_name content in + let (content,names_bound) = js_of_structure typedtree in + let pre_res = ppf_module_wrap module_name content names_bound in let str_ppf = Format.str_formatter in Format.fprintf str_ppf (Scanf.format_from_string pre_res ""); Format.flush_str_formatter () diff --git a/generator/main.ml b/generator/main.ml index 0401923739762fd43b1e5841015504870c4d5a73..0f6a59201c84959d68cc35d4f7c77118e99b6327 100644 --- a/generator/main.ml +++ b/generator/main.ml @@ -34,6 +34,7 @@ let _ = failwith "The file name must be of the form *.ml"; let basename = Filename.chop_suffix (Filename.basename sourcefile) ".ml" in let dirname = Filename.dirname sourcefile in + let pathname = if dirname = "" then basename else (dirname ^ "/" ^ basename) in let log_output, unlog_output, token_output = match !outputfile with | None -> Filename.concat dirname (basename ^ ".log.js"), @@ -56,7 +57,7 @@ let _ = in match !current_mode with - | Mode_cmi -> Printf.printf "wrote cmi file\n" + | Mode_cmi -> Printf.printf "Wrote %s.cmi\n" pathname | _ -> let out = Js_of_ast.to_javascript basename module_name typedtree1 in let output_filename = match !current_mode with @@ -66,4 +67,4 @@ let _ = | _ -> assert false in file_put_contents output_filename out; - Printf.printf "wrote %s\n" output_filename + Printf.printf "Wrote %s\n" output_filename diff --git a/generator/params.ml b/generator/params.ml index a9722ed388aa690e6b46f0accad35aa0b26c78ae..1d8705a43c2983eb03e804995a5c884593270726 100644 --- a/generator/params.ml +++ b/generator/params.ml @@ -1,5 +1,8 @@ let debug = ref false +let (~~) f x y = f y x + + (****************************************************************) (* MODES *)