Commit c5382b58 authored by lucas.coatanlem's avatar lucas.coatanlem
Browse files

Adding functions :

	- in compile/operators.ml : register_fun3 (id register_fun2 with 3 args)
	- compute_depend (has been modified)
	- in runtime/cduce_js.ml :
		- load_from_dom
		- replace_inner
		- replace_outer
		- test_register3
		- define_prims (Js function)
	- in runtime/print_xml.ml and types/builtin.ml :
		Adding functions developped in previous file as primitives
parent 8c2f2dd3
......@@ -56,6 +56,20 @@ let register_fun2 op dom1 dom2 codom eval =
(Value.Abstraction (Some [(dom1,t2)],(fun v1 ->
Value.Abstraction (iface2,
eval v1, Value.Identity)), Value.Identity))
let register_fun3 op dom1 dom2 dom3 codom eval =
let t3 = Types.arrow (Types.cons dom3) (Types.cons codom) in
let t2 = Types.arrow (Types.cons dom2) (Types.cons t3) in
let iface3 = Some [(dom3,codom)] in
let iface2 = Some [(dom2,t3)] in
register_cst op
(Types.arrow (Types.cons dom1) (Types.cons t2))
(Value.Abstraction (Some [(dom1,t2)], (fun v1 ->
Value.Abstraction (iface2, (fun v2 ->
Value.Abstraction (iface3, eval v1 v2, Value.Identity)),Value.Identity)),Value.Identity))
let register_op op ?(expect=Types.any) typ eval =
register_unary op
(fun tf _ _ -> let t = tf expect true in typ t)
......
......@@ -11,6 +11,8 @@ val register_binary:
val register_fun: string -> Types.t -> Types.t -> (Value.t -> Value.t) -> unit
val register_fun2: string -> Types.t -> Types.t -> Types.t -> (Value.t -> Value.t -> Value.t) -> unit
val register_fun3: string -> Types.t -> Types.t -> Types.t -> Types.t -> (Value.t -> Value.t -> Value.t -> Value.t) -> unit
val register_cst: string -> Types.t -> Value.t -> unit
val register_op:
string -> ?expect:Types.t -> (Types.t -> Types.t) -> (Value.t -> Value.t) -> unit
......
......@@ -288,9 +288,9 @@ driver/cduce.cmx : runtime/value.cmx parser/ulexer.cmx types/types.cmx \
compile/lambda.cmx types/ident.cmx runtime/eval.cmx compile/compile.cmx \
parser/cduce_loc.cmx types/builtin_defs.cmx types/builtin.cmx \
compile/auto_pat.cmx types/atoms.cmx parser/ast.cmx driver/cduce.cmi
parser/cduce_curl.cmo : runtime/value.cmi parser/cduce_url.cmi \
parser/cduce_netclient.cmo : runtime/value.cmi parser/cduce_url.cmi \
driver/cduce_config.cmi
parser/cduce_curl.cmx : runtime/value.cmx parser/cduce_url.cmx \
parser/cduce_netclient.cmx : runtime/value.cmx parser/cduce_url.cmx \
driver/cduce_config.cmx
runtime/cduce_pxp.cmo : runtime/value.cmi schema/schema_xml.cmi \
runtime/load_xml.cmi parser/cduce_url.cmi driver/cduce_config.cmi \
......@@ -304,22 +304,16 @@ runtime/cduce_pxp.cmo : runtime/value.cmi schema/schema_xml.cmi \
runtime/cduce_pxp.cmx : runtime/value.cmx schema/schema_xml.cmx \
runtime/load_xml.cmx parser/cduce_url.cmx driver/cduce_config.cmx \
runtime/cduce_pxp.cmi
runtime/cduce_expat.cmo : runtime/value.cmi schema/schema_xml.cmi \
runtime/load_xml.cmi parser/cduce_url.cmi driver/cduce_config.cmi \
runtime/cduce_expat.cmi
runtime/cduce_expat.cmx : runtime/value.cmx schema/schema_xml.cmx \
runtime/load_xml.cmx parser/cduce_url.cmx driver/cduce_config.cmx \
runtime/cduce_expat.cmi
driver/run.cmo : runtime/value.cmi parser/ulexer.cmi misc/stats.cmi \
driver/librarian.cmi types/ident.cmo misc/html.cmi parser/cduce_loc.cmi \
driver/cduce_config.cmi driver/cduce.cmi types/builtin.cmi
driver/run.cmx : runtime/value.cmx parser/ulexer.cmx misc/stats.cmx \
driver/librarian.cmx types/ident.cmx misc/html.cmx parser/cduce_loc.cmx \
driver/cduce_config.cmx driver/cduce.cmx types/builtin.cmx
driver/cduce_js_runtime.cmo : driver/librarian.cmi types/ident.cmo \
parser/cduce_loc.cmi runtime/cduce_js.cmi driver/cduce_config.cmi
driver/cduce_js_runtime.cmx : driver/librarian.cmx types/ident.cmx \
parser/cduce_loc.cmx runtime/cduce_js.cmx driver/cduce_config.cmx
driver/cduce_js_runtime.cmo : runtime/cduce_js.cmi driver/cduce_config.cmi \
driver/cduce.cmi
driver/cduce_js_runtime.cmx : runtime/cduce_js.cmx driver/cduce_config.cmx \
driver/cduce.cmx
driver/start.cmo : driver/run.cmo
driver/start.cmx : driver/run.cmx
driver/examples.cmo :
......@@ -356,8 +350,10 @@ runtime/cduce_pxp.cmo : runtime/value.cmi schema/schema_xml.cmi \
runtime/cduce_pxp.cmx : runtime/value.cmx schema/schema_xml.cmx \
runtime/load_xml.cmx parser/cduce_url.cmx driver/cduce_config.cmx \
runtime/cduce_pxp.cmi
runtime/cduce_js.cmo : runtime/load_xml.cmi runtime/cduce_js.cmi
runtime/cduce_js.cmx : runtime/load_xml.cmx runtime/cduce_js.cmi
runtime/cduce_js.cmo : runtime/value.cmi runtime/print_xml.cmi \
runtime/load_xml.cmi runtime/cduce_js.cmi
runtime/cduce_js.cmx : runtime/value.cmx runtime/print_xml.cmx \
runtime/load_xml.cmx runtime/cduce_js.cmi
driver/cduce_config.cmi :
misc/stats.cmi :
misc/encodings.cmi : misc/custom.cmo
......@@ -434,7 +430,6 @@ driver/cduce.cmi : runtime/value.cmi types/atoms.cmi
runtime/cduce_pxp.cmi :
runtime/cduce_pxp.cmi :
runtime/cduce_expat.cmi :
runtime/cduce_expat.cmi :
runtime/cduce_pxp.cmi :
runtime/cduce_js.cmi :
schema/schema_types.cmi : runtime/value.cmi misc/ns.cmi misc/encodings.cmi \
......
......@@ -12,7 +12,7 @@ let load_from_dom start_e end_e text_e id =
| Some elem ->
let elem_node = (elem :> Dom.node Js.t) in
let elem_node_opt = Js.Opt.return elem_node in
let rec parse elem =
let rec parse ?(root=false) elem =
match Js.Opt.to_option elem with
None -> ()
| Some elem ->
......@@ -45,11 +45,11 @@ let load_from_dom start_e end_e text_e id =
| _ -> ignore
in
parse (elem ## firstChild);
parse (elem ## nextSibling);
if not root then parse (elem ## nextSibling);
cont ()
end
in
parse elem_node_opt
parse ~root:true elem_node_opt
let replace_inner id str =
......@@ -57,7 +57,7 @@ let replace_inner id str =
let elem = Dom_html.document ## getElementById (Js.string id) in
match Js.Opt.to_option elem with
None -> Value.failwith' ("No element with id : " ^ id)
| Some elem -> elem ## innerHTML = (Js.string str)
| Some elem -> elem ## innerHTML <- (Js.string str)
let replace_outer id str =
......@@ -65,18 +65,27 @@ let replace_outer id str =
let elem = Dom_html.document ## getElementById (Js.string id) in
match Js.Opt.to_option elem with
None -> Value.failwith' ("No element with id : " ^ id)
| Some elem -> elem ## outerHTML = (Js.string str)
| Some elem -> elem ## outerHTML <- (Js.string str)
(* Tests
let _ = replace_inner "foo" "bar"
let _ = replace_outer "foo" "bar"
let _ = load_from_dom
Load_xml.start_element_handler
Load_xml.end_element_handler
Load_xml.text_handler
"foo"
*)
let test_register3 id str1 str2 =
(* replace id by str1@str2 *)
let elem = Dom_html.document ## getElementById (Js.string id) in
let str = str1^str2 in
match Js.Opt.to_option elem with
None -> Value.failwith' ("No element with id : " ^ id)
| Some elem -> elem ## innerHTML <- (Js.string str)
let define_prims () =
Js.Unsafe.eval_string "
window.js_get_properties = function (o){
var res = [];
for(var n in o){
res.push({ 'name': n,
'value': (o[n] + '') });
};
return res;
};
console.log('ok');"
let use () =
......@@ -85,3 +94,8 @@ let use () =
Load_xml.end_element_handler
Load_xml.text_handler
;
Print_xml.replace_inner := replace_inner;
Print_xml.replace_outer := replace_outer;
Print_xml.test_register3 := test_register3;
define_prims()
......@@ -219,3 +219,8 @@ let print_xml_subst ~utf8 ns_table s subst =
let dump_xml ~utf8 ns_table s =
to_buf ~utf8 print_string ns_table s [];
Value.nil
(* TODO Lucas : A effacer? *)
let replace_inner = ref (fun _ _ -> failwith "unimplemented primitive")
let replace_outer = ref (fun _ _ -> failwith "unimplemented primitive")
let test_register3 = ref (fun _ _ _ -> failwith "unimplemented primitive")
......@@ -2,3 +2,7 @@ val print_xml: utf8:bool -> Ns.table -> Value.t -> Value.t
val dump_xml: utf8:bool -> Ns.table -> Value.t -> Value.t
val print_xml_subst: utf8:bool -> Ns.table -> Value.t ->
(Ns.Uri.t * Ns.Uri.t) list -> Value.t
val replace_inner : (string -> string -> unit) ref
val replace_outer : (string -> string -> unit) ref
val test_register3 : (string -> string -> string -> unit) ref
......@@ -5,5 +5,9 @@ let fact (n : Int) : Int =
let x = fact 24
let [] = print (string_of x)
let doc = load_xml "foo" (* raises an exception for now *)
let [] = print (print_xml doc) (* besoin de faire print print_xml !!! *)
\ No newline at end of file
let doc = load_xml "foo"
let [] = replace_outer "foo" (print_xml <div id="bar1">[])
(* "<div id='bar' />" *)
let [] = replace_inner "bar1" (print_xml <div id="bar2">[])
let [] = test_register3 "bar2" "a" "b"
let [] = print (print_xml doc)
\ No newline at end of file
<html>
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>Test js_of_ocaml</title>
<script type="text/javascript" src="main.js" > </script>
</head>
Activer la console javascript avec Ctrl-Shif-I -> Console
<div id="foo"/>
<body>
Activer la console javascript avec Ctrl-Shif-I -&gt; Console
<div id="foo"/>
<script type="text/javascript" src="main.js" > </script>
</body>
</html>
......@@ -231,6 +231,8 @@ register_fun "print_xml_utf8"
(fun v -> Print_xml.print_xml ~utf8:true !Eval.ns_table v);;
register_fun "dump_xml"
Types.any nil
(fun v ->
......@@ -244,6 +246,33 @@ register_fun "dump_xml_utf8"
Print_xml.dump_xml ~utf8:true !Eval.ns_table v);;
register_fun2 "replace_inner"
string_latin1 string_latin1 nil
(fun id str ->
!Print_xml.replace_inner
(Value.get_string_latin1 id)
(Value.get_string_latin1 str);
Value.nil
);;
register_fun2 "replace_outer"
string_latin1 string_latin1 nil
(fun id str ->
!Print_xml.replace_outer
(Value.get_string_latin1 id)
(Value.get_string_latin1 str);
Value.nil
);;
register_fun3 "test_register3"
string_latin1 string_latin1 string_latin1 nil
(fun a b c ->
!Print_xml.test_register3
(Value.get_string_latin1 a)
(Value.get_string_latin1 b)
(Value.get_string_latin1 c);
Value.nil);;
register_fun "print"
string_latin1 nil
(fun v ->
......
Markdown is supported
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