Commit 7553b05a authored by Kim Nguyễn's avatar Kim Nguyễn
Browse files

Remove dead code, and fix jsoo backend for handling urls.

parent 1aeb2710
......@@ -54,7 +54,7 @@ let load_xml open_cb close_cb text_cb txt =
let get_fun = function Value.Abstraction (_, f) -> f | _ -> assert false
let load_url_async url cb_ok cb_err =
let load_url async url cb_ok cb_err =
let xhr = XmlHttpRequest.create () in
xhr##.onreadystatechange :=
Js.wrap_callback (fun () ->
......@@ -64,30 +64,46 @@ let load_url_async url cb_ok cb_err =
| None -> ""
| Some s -> Js.to_string s
in
let cb_ok = get_fun cb_ok in
let cb_err = get_fun cb_err in
let text = Value.string_utf8 (Encodings.Utf8.mk text) in
if xhr##.status == 200 then ignore (cb_ok text)
else ignore (cb_err text));
if xhr##.status == 200 then cb_ok text
else cb_err text);
xhr##_open
(Js.string "get")
(Js.string (Value.cduce2ocaml_string url))
Js._true;
xhr##send Js.null;
Value.nil
(Js.string url)
(Js.bool async);
xhr##send Js.null
let use () =
Load_xml.xml_parser :=
Stats.gettimeofday := (fun () -> (Js.date ## now /. 1000.)) ;
(* Url loading *)
Url.url_loader :=
(fun url ->
let content = ref "" in
load_url false url (fun s -> content := s)
(fun _ -> Value.failwith' ("Cannot load URL: "^url));
!content);
Load_xml.xml_parser := fun url ->
load_xml Load_xml.start_element_handler Load_xml.end_element_handler
Load_xml.text_handler;
Stats.gettimeofday := Sys.time;
Load_xml.text_handler (Url.load_url url);
let open Cduce_types in
let tstr = Builtin_defs.string in
let nil = Builtin_defs.nil in
Operators.register_fun3 "load_url_async" Builtin_defs.string
(Types.arrow (Types.cons tstr) (Types.cons nil))
(Types.arrow (Types.cons tstr) (Types.cons nil))
nil load_url_async
nil (fun curl cok cerr ->
let url = Encodings.Utf8.get_str (fst (Value.get_string_utf8 curl)) in
let ok = fun s -> ignore ((get_fun cok) (Value.string_utf8 (Encodings.Utf8.mk s))) in
let err = fun s -> ignore ((get_fun cerr) (Value.string_utf8 (Encodings.Utf8.mk s))) in
load_url true url ok err;
Value.nil
)
let () =
Cduce_config.register
......
......@@ -87,9 +87,9 @@ let install id =
let phrase = Js.array_get fields 0 in
match Js.Optdef.to_option phrase with
| None -> Js._true
| Some phrase ->
| Some orig_phrase ->
let phrase =
((((phrase##replace rebr (Js.string "\n"))##replace
((((orig_phrase##replace rebr (Js.string "\n"))##replace
retag (Js.string ""))##replace
relt (Js.string "<"))##replace
regt (Js.string ">"))##trim
......@@ -97,7 +97,7 @@ let install id =
let phrase = Js.to_string phrase ^ ";;"in
if phrase <> ";;" then begin
Format.fprintf out_fmt "%s\n%!" phrase;
history.before <- phrase :: history.before;
history.before <- (Js.to_string orig_phrase) :: history.before;
Cduce_lib_js.Toplevel.eval_top out_fmt err_fmt phrase;
dump_buffer "out" console out_buff;
dump_buffer "err" console err_buff;
......
(*
module type T =
sig
include Custom.T
type value
val clear: unit -> unit
val mk: value -> t
val dummy_min: t
val dummy_max: t
val value: t -> value
end
module Make(H : Custom.T) =
struct
include Custom.Int
type value = H.t
module Tbl = Hashtbl.Make(H)
let cache = State.ref "Pool.cache" (Tbl.create 63)
let values = State.ref "Pool.values" (Array.create 63 None)
let counter = State.ref "Pool.counter" 0
let clear () =
Tbl.clear !cache;
values := Array.create 63 None;
counter := 0
let check i =
assert((i >= 0) && (i < !counter) && (!values.(i) <> None))
let mk x =
try Tbl.find !cache x
with Not_found ->
let n = !counter in
incr counter;
Tbl.add !cache x n;
if (n = Array.length !values) then
(
let new_values = Array.create (2 * Array.length !values) None in
Array.blit !values 0 new_values 0 n;
values := new_values
);
!values.(n) <- Some x;
n
let dummy_min = -1
let dummy_max = max_int
let value n = match !values.(n) with Some x -> x | None -> assert false
let memo =
Serialize.Put.mk_property (fun t -> Array.create !counter false)
let serialize t i =
let memo = Serialize.Put.get_property memo t in
Serialize.Put.int t i;
if not memo.(i) then (
H.serialize t (value i);
memo.(i) <- true
)
(* Use an array here ? *)
module DMemo = Map.Make(Custom.Int)
let memo = Serialize.Get.mk_property (fun t -> ref DMemo.empty)
let deserialize t =
let memo = Serialize.Get.get_property memo t in
let i = Serialize.Get.int t in
try DMemo.find i !memo
with Not_found ->
let j = mk (H.deserialize t) in
memo := DMemo.add i j !memo;
j
end
module NoHash(H : Custom.T) =
struct
include Custom.Int
type value = H.t
let values = State.ref "Pool.values" (Array.create 63 None)
let counter = State.ref "Pool.counter" 0
let clear () =
values := Array.create 63 None;
counter := 0
let check i =
assert((i >= 0) && (i < !counter) && (!values.(i) <> None))
let mk x =
let n = !counter in
incr counter;
if (n = Array.length !values) then
(
let new_values = Array.create (2 * Array.length !values) None in
Array.blit !values 0 new_values 0 n;
values := new_values
);
!values.(n) <- Some x;
n
let dummy_min = -1
let dummy_max = max_int
let value n = match !values.(n) with Some x -> x | None -> assert false
let memo =
Serialize.Put.mk_property (fun t -> Array.create !counter false)
let serialize t i =
let memo = Serialize.Put.get_property memo t in
Serialize.Put.int t i;
if not memo.(i) then (
H.serialize t (value i);
memo.(i) <- true
)
(* Use an array here ? *)
module DMemo = Map.Make(Custom.Int)
let memo = Serialize.Get.mk_property (fun t -> ref DMemo.empty)
let deserialize t =
let memo = Serialize.Get.get_property memo t in
let i = Serialize.Get.int t in
try DMemo.find i !memo
with Not_found ->
let j = mk (H.deserialize t) in
memo := DMemo.add i j !memo;
j
end
module Weak(H : Custom.T) = struct
type value = H.t
module P = Weak.Make(H)
let pool = P.create 17
include H
let mk = P.merge pool
let value x = x
end
*)
(*
module type T =
sig
include Custom.T
(* Hashtbl.hash'able and Pervasives.compare'able type;
typically, t is an integer *)
type value
val clear: unit -> unit
(* Previously allocated symbols are no longer valid; no check
is provided. Registered values can be released by the GC only after
a call to clear. *)
val mk: value -> t
val dummy_min: t
val dummy_max: t
(* Two dummy symbols, not associated with any registered value;
resp. smallest and largest than any other symbol *)
val value: t -> value
end
module Make(H : Custom.T) : T with type value = H.t and type t = int
module NoHash(H : Custom.T) : T with type value = H.t and type t = int
module Weak(H : Custom.T) : sig
include Custom.T
type value = H.t
val mk: value -> t
val value: t -> value
end
*)
(*
let state = ref []
let complete = ref false
let close () =
complete := true
let register name r =
if !complete then failwith "State.register: state already closed";
state := (name,Obj.magic r) :: !state
let ref name v =
let r = ref v in
register name r;
r
let get () =
if not !complete then failwith "State.get: need to close the state";
Obj.magic (List.map (fun (name,r) -> (name, !r)) !state)
let set s =
if not !complete then failwith "State.set: need to close the state";
let rec aux = function
| [],[] -> ()
| (n1,v)::l1, (n2,r)::l2 when n1 = n2 -> r := v; aux (l1,l2)
| _ -> failwith "State.set_state: failed"
in
aux (Obj.magic s,!state)
*)
(*
(* This module provides a minimal and unsafe support for
saving/restoring the global state of the program.
It assumes that the global state is fully described by
Marshal'able references.
*)
val ref: string -> 'a -> 'a ref
(* Replacement for Pervasives.ref. Creates a persistant reference.
Two runs of the programs must yield the same calls to this function,
in the correct order. The arbitrary string argument is used to
check this order (give a different string for different calls).
*)
val close: unit -> unit
(* Close registration for the global state. When this function
has been called, ref becomes illegal, and get/set become
legal *)
val get: unit -> 'a
(* Get a marshal'able value representing the global state *)
val set: 'a -> unit
(* Set the global state *)
*)
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