Commit 968f4f81 authored by Aliaume Lopez's avatar Aliaume Lopez

Conversion to JS code ...

parent 2d8d84ca
OCAMLCC=ocamlc
OSRC=utils.ml lexer.ml ast.ml parser.ml dot.ml solver.ml typesystem.ml dags.ml compiler.ml ptg.ml rewriting.ml
OCAMLCC=ocamlfind ocamlc -package js_of_ocaml \
-package js_of_ocaml.syntax \
-syntax camlp4o
#OSRC=utils.ml lexer.ml ast.ml parser.ml dot.ml solver.ml typesystem.ml dags.ml compiler.ml ptg.ml rewriting.ml
OSRC=utils.cmo lexer.cmo ast.cmo parser.cmo dot.cmo solver.cmo typesystem.cmo dags.cmo compiler.cmo ptg.cmo rewriting.cmo
.PHONY: test clean doc
......@@ -14,9 +17,18 @@ tests: $(OSRC) tests.ml
$(OCAMLCC) -g -o tests $(OSRC) tests.ml
./tests
circuits: $(OSRC) circuits.ml
mkdir -p graphics
$(OCAMLCC) -g -o circuits $(OSRC) circuits.ml
circuits.bytes: $(OSRC)
$(OCAMLCC) -g -linkpkg -o $@ $(OSRC)
circuits.js: circuits.bytes
js_of_ocaml $<
%.cmo: %.ml
$(OCAMLCC) -c $<
#circuits: $(OSRC) circuits.ml
#mkdir -p graphics
#$(OCAMLCC) -g -o circuits $(OSRC) circuits.ml
clean:
rm *.cmi
......
......@@ -167,8 +167,8 @@ let ptg_of_dag dag =
* FIRST OF ALL TRANSLATE ALL THE NAMES SO THAT
* THEY DO NOT CONFLICT WITH OTHER PTG NAMES
*)
let dag = mapids (fun x -> x + !counter) dag in
counter := 10 + maxid dag;
let dag = mapids (fun x -> x + !Ptg.counter) dag in
Ptg.counter := 10 + maxid dag;
(*
* then extract the informations
......@@ -240,16 +240,15 @@ let ptg_of_dag dag =
(**** MAIN ENTRY POINT ****)
let get_dag_of_file file =
let ic = open_in file in
let buf = Buffer.create 80 in
Stream.of_channel ic |> Stream.iter (Buffer.add_char buf);
let input = Buffer.contents buf in
(* Construct a DAG form input string *)
let get_dag_of_string input =
(* Lex the string before parsing *)
let lexed = input |> Lexer.do_lexing in
print_string "\n\nLEXED : ";
print_string lexed;
print_string lexed; (* DEBUG PRINT *)
print_string "\n\n\n";
(*let parsed = lexed |> Parser.parse_ast in *)
(* Parse the lexed string *)
let parsed = lexed |> Parser.parse_eval in
print_string "\n\nPARSED : ";
print_string (Ast.print_ast parsed);
......@@ -257,17 +256,33 @@ let get_dag_of_file file =
let compiled = parsed |> Compiler.typecheck_and_compile in
compiled;;
(* Construct a DAG form input file *)
let get_dag_of_file file =
(* Open the file and read contents *)
let ic = open_in file in
let buf = Buffer.create 80 in
Stream.of_channel ic |> Stream.iter (Buffer.add_char buf);
(* Create the corresponding string *)
let input = Buffer.contents buf in
get_dag_of_string input;;
(* Construct a PTG from a file *)
let get_ptg_of_file file =
file |> get_dag_of_file |> ptg_of_dag ;;
(* Construct a PTG from a string *)
let get_ptg_of_string input =
input |> get_dag_of_string |> ptg_of_dag ;;
(* Write a dot output to a file *)
let ptg_to_file fname ptg =
let fhandle = open_out fname in
ptg |> dot_of_ptg
|> output_string fhandle;
close_out fhandle;;
(* Write a dot output to a string *)
let ptg_to_string ptg = (dot_of_ptg ptg : string);; (* dumb alias *)
(***** APPLICATION OF REWRITING RULES *******)
......@@ -280,7 +295,7 @@ let fc = ref 0;;
* and writes the dot conversion into the
* according testXXX file
*)
let report txt ptg =
let report_old txt ptg =
incr fc;
let base = Printf.sprintf "graphics/test%03d" !fc in
(*print_string (txt ^ ": " ^ base ^ "\n");*)
......@@ -289,6 +304,32 @@ let report txt ptg =
Sys.command ("dot -Tpdf " ^ base ^ ".dot" ^ " -o " ^ base ^ ".pdf");
();;
(**
* Report a graph using fancy JS stuff
*)
let report txt ptg =
let ptg_array = (Js.Unsafe.coerce Js.Unsafe.global)##ptgarr in
let txt_array = (Js.Unsafe.coerce Js.Unsafe.global)##txtarr in
let log_array = (Js.Unsafe.coerce Js.Unsafe.global)##outarr in
Js.array_set ptg_array !fc (ptg_to_string ptg);
Js.array_set txt_array !fc txt;
incr fc;
Js.array_set log_array !fc (Js.array [| |]);;
let report_output values =
let log_array = (Js.Unsafe.coerce Js.Unsafe.global)##outarr in
let cur_log = Js.Optdef.get
(Js.array_get log_array !fc)
(fun () -> assert false)
in
let arrval =
values |> List.map (fun x -> Js.string (Ptg.string_of_value x))
|> Array.of_list
|> Js.array
in
cur_log##push(arrval);
();;
(* Some utility functions for the local rules application *)
let apply_local_rule rule ptg =
......@@ -336,9 +377,10 @@ let looping_reduction_step x =
try
let (v, x1) = Rewriting.first_output x in
print_string "OUTPUT DETECTED : ";
v |> List.map string_of_value |> String.concat ", " |> print_string;
print_newline ();
(*print_string "OUTPUT DETECTED : ";*)
(*v |> List.map string_of_value |> String.concat ", " |> print_string;*)
(*print_newline ();*)
report_output v;
x1
with
Rewriting.NoFirstValue ->
......@@ -355,30 +397,46 @@ let looping_reduction_step x =
*
* The program's entry point
*
* x = the ptg input as a reference
* steps = the maximal number of steps
* depth = the maximal depth
*)
let () =
print_string "CIRCUITS - \n";
let file = if Array.length Sys.argv > 1 then
Sys.argv.(1)
else
"lines.txt"
in
let x = ref (get_ptg_of_file file) in
let main_function x steps depth =
(* initialise counters *)
fc := 0;
let i = ref 0 in
(*Ptg.init_counters ();*)
(*Dags.init_counters ();*)
report "INIT" !x;
x := Rewriting.normal_timed_form !x;
report "INIT" !x;
let n = 15 in
for i = 1 to n do
let y = looping_reduction_step !x in
if y == !x then
failwith "No more modification possible"
else
x := y
while !i <= depth && !fc < steps do
incr i;
let y = looping_reduction_step !x in
if y == !x then
failwith "No more modification possible"
else
x := y
done;
x := Rewriting.garbage_collect_dual !x;
report "GARBAGE COLLECT" !x;
();;
let () =
Js.Unsafe.global##launchNukes <- Js.wrap_callback
(fun text steps depth ->
let y : string = Js.to_string text in
let s : ptg = get_ptg_of_string y in
let r : ptg ref = ref s in
main_function r steps depth)
(*let file = if Array.length Sys.argv > 1 then *)
(*Sys.argv.(1) *)
(*else*)
(*"lines.txt"*)
(*in*)
(*let x = ref (get_ptg_of_file file) in *)
(*main_function x 50 15*)
;;
......@@ -30,6 +30,9 @@ let map_port f (a,b) = (f a, b)
let counter = ref 0;;
let newvar () = incr counter; !counter;;
let init_counters () =
counter := 0;;
(**
* A liDAG with
* a placeholder for information such as
......
......@@ -84,12 +84,18 @@ let id_update k f y =
| None -> id_remove k y
| Some x -> id_add k x y;;
(*
* Merging for maps key valueA valueB
* they should always be disjoint
* when merging, and we raise an
* error when they are not
*)
let merger_v k a b = match a, b with
| None , None -> None
| Some a, None -> Some a
| None , Some b -> Some b
| Some a, Some b when a = b -> Some a
| Some a, Some b -> failwith "MERGE ERROR CONFLICTING VALUES";; (* Some a ;; (** default value ... Careful !!!*)*)
| Some a, Some b -> failwith "NON UNIQUE IDS FOR DIFFERENT ELEMENTS";; (* Some a ;; (** default value ... Careful !!!*)*)
type gate =
......@@ -243,13 +249,21 @@ let counter = ref 0;;
let newid () =
incr counter; !counter;;
let e_counter = ref 0;;
let e_counter = ref 0;;
let neweid () =
incr e_counter; !e_counter;;
let newids n = Utils.range n |> List.map (fun _ -> newid ());;
let neweids n = Utils.range n |> List.map (fun _ -> neweid ());;
(***
* WARNING: DO NOT USE DURING
* CALCULATION
*)
let init_counters () =
counter := 0;
e_counter := 0;;
(**** BASE OPERATIONS ****)
......
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