aboutsummaryrefslogtreecommitdiffstats
path: root/_khb_experiment
diff options
context:
space:
mode:
Diffstat (limited to '_khb_experiment')
-rw-r--r--_khb_experiment/_tags3
-rw-r--r--_khb_experiment/khb_ast.ml27
-rw-r--r--_khb_experiment/khs_ast.ml36
-rw-r--r--_khb_experiment/khs_exec.ml225
-rw-r--r--_khb_experiment/khs_exec_local.ml73
-rw-r--r--_khb_experiment/khs_exec_seq.ml62
-rw-r--r--_khb_experiment/ksh_print.ml53
-rw-r--r--_khb_experiment/test.khb67
-rw-r--r--_khb_experiment/test.khs76
-rw-r--r--_khb_experiment/test.ml101
-rw-r--r--_khb_experiment/util.ml10
11 files changed, 733 insertions, 0 deletions
diff --git a/_khb_experiment/_tags b/_khb_experiment/_tags
new file mode 100644
index 0000000..f36ce04
--- /dev/null
+++ b/_khb_experiment/_tags
@@ -0,0 +1,3 @@
+true: use_menhir
+<*.byte>: use_unix
+<*.native>: use_unix
diff --git a/_khb_experiment/khb_ast.ml b/_khb_experiment/khb_ast.ml
new file mode 100644
index 0000000..fa52ece
--- /dev/null
+++ b/_khb_experiment/khb_ast.ml
@@ -0,0 +1,27 @@
+
+type khb_binop =
+ | PLUS | MINUS
+ | TIMES | DIV | MOD
+ | EQUAL | NEQUAL
+ | GT | LT | GE | LE
+ | AND | OR | XOR
+ | SEND | RECV | ASSIGN | SEQ
+
+type khb_unop =
+ | MINUS | NOT
+ | DEREF | REF
+
+
+type khb_expr =
+ | BVar of string
+ | BStr of string
+ | BInt of int
+ | BBool of bool
+ | BUnary of unop * expr
+ | BBinary of expr * unop * expr
+ | BTernary of expr * expr * expr
+ | BCall of string * expr list
+ | BLoop of expr
+ | BNewChan
+ | BPar of expr
+ | BIndex of expr * expr
diff --git a/_khb_experiment/khs_ast.ml b/_khb_experiment/khs_ast.ml
new file mode 100644
index 0000000..f5b2c8d
--- /dev/null
+++ b/_khb_experiment/khs_ast.ml
@@ -0,0 +1,36 @@
+
+type khs_binop =
+ | PLUS | MINUS
+ | TIMES | DIV | MOD
+ | EQUAL | NEQUAL
+ | GT | LT | GE | LE
+ | AND | OR | XOR
+
+type khs_unop =
+ | MINUS | NOT
+
+type khs_expr =
+ | EEmpty
+ | EInt of int
+ | EStr of string
+ | EBool of bool
+ | EFrame
+ | ELocal of string
+ | EBinary of khs_expr * khs_binop * khs_expr
+ | EUnary of khs_unop * khs_expr
+ | ETernary of khs_expr * khs_expr * khs_expr
+ | ECat of khs_expr * khs_expr
+ | ELoad of khs_expr
+ | ENewChan
+
+type khs_stmt =
+ | SLabel of string
+ | SSet of khs_expr * khs_expr
+ | SGoto of khs_expr
+ | SPar of khs_expr
+ (* RECV and SEND do a load on their second argument (the chan),
+ (ie they expect an address and not a value) *)
+ | SRecv of khs_expr * khs_expr
+ | SSend of khs_expr * khs_expr
+ | SUnset of khs_expr list
+ | SExit
diff --git a/_khb_experiment/khs_exec.ml b/_khb_experiment/khs_exec.ml
new file mode 100644
index 0000000..ff050c6
--- /dev/null
+++ b/_khb_experiment/khs_exec.ml
@@ -0,0 +1,225 @@
+open Util
+open Khs_ast
+
+
+type kprog =
+ {
+ pinstr: khs_stmt array;
+ plabels: int Smap.t;
+ }
+
+type kbval =
+ | VNone
+ | VInt of int
+ | VBool of bool
+ | VStr of string
+type kval =
+ | Single of kbval
+ | Many of kbval Smap.t
+
+type chanid = kbval
+
+type kprocstatus =
+ | PSExec
+ | PSSend of chanid * kval
+ | PSRecv of chanid
+ | PSExecRecvd of kval
+ | PSDone
+
+type kproc =
+ {
+ xspawn: kproc -> int -> unit;
+ xnewchan: kproc -> kval;
+ xprog: kprog;
+ mutable xvals: kbval Smap.t;
+ mutable xstatus: kprocstatus;
+ mutable xpos: int
+ }
+
+let psep = "\\"
+let framevar = "#"
+
+
+(* Procedures on values *)
+
+(* Strange semantics : all type conversions are allowed *)
+let int_of_kbval = function
+ | VInt i -> i
+ | VBool true -> 1
+ | VBool false -> 0
+ | VNone -> 0
+ | VStr s -> int_of_string s
+let str_of_kbval = function
+ | VInt i -> string_of_int i
+ | VBool true -> "1"
+ | VBool false -> "0"
+ | VNone -> ""
+ | VStr s -> s
+let bool_of_kbval = function
+ | VInt i -> i <> 0
+ | VBool b -> b
+ | VNone -> false
+ | VStr s -> (int_of_string s) <> 0
+
+let kval_of_kbval v = Single v
+let kbval_of_kval = function
+ | Single v -> v
+ | Many a ->
+ try Smap.find "" a
+ with Not_found -> VNone
+
+let int_of_kval v = int_of_kbval (kbval_of_kval v)
+let bool_of_kval v = bool_of_kbval (kbval_of_kval v)
+let str_of_kval v = str_of_kbval (kbval_of_kval v)
+
+let kval_descr = function
+ | Single v -> "'" ^ str_of_kbval v ^ "'"
+ | Many a ->
+ if Smap.cardinal a = 1 then
+ Smap.fold (fun k v s -> str_of_kbval v) a ""
+ else
+ Smap.fold (fun k v s -> s ^ "\n " ^ k ^ " : '" ^ str_of_kbval v ^ "'")
+ a "{"
+ ^ "\n}"
+
+(* Variable loading and setting *)
+let load_kval proc key =
+ let n = String.length key in
+ let ret = ref Smap.empty in
+ Smap.iter (fun k v ->
+ if k = key ||
+ (String.length k > n &&
+ String.sub k 0 (n+1) = key ^ psep)
+ then
+ ret := Smap.add (String.sub k n (String.length k - n)) v !ret)
+ proc.xvals;
+ (* Format.printf "Load %s : %s@." key (kval_descr (Many (!ret))); *)
+ Many(!ret)
+let save_kval proc key value =
+ (* Format.printf "Set %s = %s@." key (kval_descr value); *)
+ match value with
+ | Single s -> proc.xvals <- Smap.add key s proc.xvals
+ | Many m ->
+ Smap.iter
+ (fun k v -> proc.xvals <- Smap.add (key ^ k) v proc.xvals)
+ m
+let unset_kval proc key =
+ let n = String.length key in
+ let f k _ =
+ k <> key &&
+ (String.length k < n + 1 ||
+ String.sub k 0 (n+1) <> key ^ psep)
+ in
+ proc.xvals <- Smap.filter f proc.xvals
+
+(* Expression evaluation *)
+let rec eval_expr proc = function
+ | EEmpty -> Single VNone
+ | EInt i -> Single (VInt i)
+ | EBool b -> Single (VBool b)
+ | EStr s -> Single (VStr s)
+ | ELocal l ->
+ Single(VStr(str_of_kval (load_kval proc framevar) ^ psep ^ l))
+ | EFrame -> Single(VStr framevar)
+ | EBinary(e1, op, e2) ->
+ let v1, v2 = eval_expr proc e1, eval_expr proc e2 in
+ let r = match op with
+ | PLUS -> VInt(int_of_kval v1 + int_of_kval v2)
+ | MINUS -> VInt(int_of_kval v1 - int_of_kval v2)
+ | TIMES -> VInt(int_of_kval v1 * int_of_kval v2)
+ | DIV -> VInt(int_of_kval v1 / int_of_kval v2)
+ | MOD -> VInt(int_of_kval v1 mod int_of_kval v2)
+ | EQUAL -> VBool(kbval_of_kval v1 = kbval_of_kval v2)
+ (* EQUAL does not test values in depth ! *)
+ | NEQUAL -> VBool(kbval_of_kval v1 <> kbval_of_kval v2)
+ | GT -> VBool(int_of_kval v1 > int_of_kval v2)
+ | LT -> VBool(int_of_kval v1 < int_of_kval v2)
+ | GE -> VBool(int_of_kval v1 >= int_of_kval v2)
+ | LE -> VBool(int_of_kval v1 <= int_of_kval v2)
+ | AND -> VBool(bool_of_kval v1 && bool_of_kval v2)
+ | OR -> VBool(bool_of_kval v1 || bool_of_kval v2)
+ | XOR -> VBool(bool_of_kval v1 ^^ bool_of_kval v2)
+ in Single r
+ | EUnary(op, e) ->
+ let v = eval_expr proc e in
+ let r = match op with
+ | MINUS -> VInt(-(int_of_kval v))
+ | NOT -> VBool(not(bool_of_kval v))
+ in Single r
+ | ETernary(cond, e1, e2) ->
+ if bool_of_kval (eval_expr proc cond) then
+ eval_expr proc e1
+ else
+ eval_expr proc e2
+ | ECat(e1, e2) ->
+ Single(VStr(
+ str_of_kval (eval_expr proc e1)
+ ^ psep
+ ^ str_of_kval (eval_expr proc e2)))
+ | ELoad(x) ->
+ load_kval proc (str_of_kval (eval_expr proc x))
+ | ENewChan -> proc.xnewchan proc
+
+let exec_stmt proc =
+ match proc.xprog.pinstr.(proc.xpos) with
+ | SLabel _ ->
+ proc.xpos <- proc.xpos + 1 (* nothing to do *)
+ | SSet(var, v) ->
+ let var = str_of_kval (eval_expr proc var) in
+ let v = eval_expr proc v in
+ save_kval proc var v;
+ proc.xpos <- proc.xpos + 1
+ | SGoto pos ->
+ let pos = str_of_kval (eval_expr proc pos) in
+ begin
+ try
+ proc.xpos <- Smap.find pos proc.xprog.plabels
+ with Not_found ->
+ proc.xstatus <- PSDone
+ end
+ | SPar pos ->
+ let pos = str_of_kval (eval_expr proc pos) in
+ begin
+ try
+ proc.xspawn proc (Smap.find pos proc.xprog.plabels)
+ with Not_found -> ()
+ end;
+ proc.xpos <- proc.xpos + 1
+ | SRecv(var, chan) ->
+ begin match proc.xstatus with
+ | PSExec ->
+ let chan = kbval_of_kval (eval_expr proc (ELoad chan)) in
+ proc.xstatus <- PSRecv chan
+ | PSExecRecvd v ->
+ let var = str_of_kval (eval_expr proc var) in
+ save_kval proc var v;
+ proc.xstatus <- PSExec;
+ proc.xpos <- proc.xpos + 1
+ | _ -> assert false
+ end
+ | SSend(v, chan) ->
+ let chan = kbval_of_kval (eval_expr proc (ELoad chan)) in
+ let v = eval_expr proc v in
+ proc.xpos <- proc.xpos + 1;
+ proc.xstatus <- PSSend(chan, v)
+ | SUnset(l) ->
+ List.iter (unset_kval proc)
+ (List.map (fun e -> str_of_kval (eval_expr proc e)) l);
+ proc.xpos <- proc.xpos + 1;
+ | SExit ->
+ proc.xstatus <- PSDone
+
+
+(* Load program, ie find labels *)
+let load_program p =
+ let labels = ref Smap.empty in
+ Array.iteri
+ (fun i x ->
+ match x with
+ | SLabel l -> labels := Smap.add l i !labels
+ | _ -> ())
+ p;
+ { pinstr = p; plabels = !labels }
+
+
+
diff --git a/_khb_experiment/khs_exec_local.ml b/_khb_experiment/khs_exec_local.ml
new file mode 100644
index 0000000..09f14a8
--- /dev/null
+++ b/_khb_experiment/khs_exec_local.ml
@@ -0,0 +1,73 @@
+open Util
+open Khs_ast
+open Khs_exec
+
+(* TODO : channels cannot be communicated over channels, although
+ it should totally be possible because it's so great and so usefull ! *)
+
+let childs = ref []
+
+let wait_childs () =
+ Unix.handle_unix_error (fun () ->
+ List.iter (fun pid -> ignore (Unix.waitpid [] pid)) !childs)
+ ()
+
+let newchan proc =
+ let id = "khs_ch_" ^ string_of_int (Random.int 1000000)
+ ^ "-" ^ string_of_int (Random.int 1000000) in
+ Unix.mkfifo ("/tmp/" ^ id) 0o666;
+ Many (Smap.add (psep^"in") (VStr id)
+ (Smap.add (psep^"out") (VStr id) Smap.empty))
+
+let exec_proc proc =
+ while proc.xstatus <> PSDone do
+ match proc.xstatus with
+ | PSDone -> assert false
+ | PSExec | PSExecRecvd _ ->
+ exec_stmt proc
+ | PSSend(c, kv) ->
+ let c = str_of_kbval c in
+ proc.xstatus <- PSExec;
+ begin
+ if c == "stdout" then
+ Format.printf "%s@." (kval_descr kv)
+ else
+ let c_out = Unix.openfile ("/tmp/"^c) [Unix.O_WRONLY] 0 in
+ Marshal.to_channel (Unix.out_channel_of_descr c_out) kv [];
+ Unix.close c_out
+ end
+ | PSRecv c ->
+ let c = str_of_kbval c in
+ let c_in = Unix.openfile ("/tmp/"^c) [Unix.O_RDONLY] 0 in
+ let data = Marshal.from_channel (Unix.in_channel_of_descr c_in) in
+ proc.xstatus <- PSExecRecvd data;
+ Unix.close c_in
+ done
+
+let spawn proc pos =
+ let pid = Unix.fork () in
+ if pid = 0 then begin
+ childs := [];
+ exec_proc { proc with xpos = pos};
+ wait_childs();
+ exit 0
+ end else
+ childs := pid::!childs
+
+
+
+let exec_program p =
+ Random.init (int_of_float (Unix.time()));
+ let proc = {
+ xspawn = spawn;
+ xnewchan = newchan;
+ xprog = p;
+ xvals = Smap.empty;
+ xstatus = PSExec;
+ xpos = 0;
+ } in
+ proc.xvals <- Smap.add framevar (VInt 0) proc.xvals;
+ proc.xvals <- Smap.add "stdout" (VStr "stdout") proc.xvals;
+ exec_proc proc;
+ wait_childs()
+
diff --git a/_khb_experiment/khs_exec_seq.ml b/_khb_experiment/khs_exec_seq.ml
new file mode 100644
index 0000000..6e34767
--- /dev/null
+++ b/_khb_experiment/khs_exec_seq.ml
@@ -0,0 +1,62 @@
+open Util
+open Khs_ast
+open Khs_exec
+
+let chans = Hashtbl.create 12
+let ch_id =
+ let p = ref 0 in
+ fun () -> p := !p + 1; !p
+
+let proc = ref []
+let proc_spawned = ref []
+
+let spawn proc pos =
+ proc_spawned :=
+ { proc with xpos = pos }::(!proc_spawned)
+
+let newchan proc =
+ let id = ch_id () in
+ Hashtbl.add chans id (Queue.create());
+ Many (Smap.add (psep^"in") (VInt id)
+ (Smap.add (psep^"out") (VInt id) Smap.empty))
+
+let proc_step proc =
+ match proc.xstatus with
+ | PSDone -> false
+ | PSExec | PSExecRecvd _ ->
+ exec_stmt proc;
+ true
+ | PSSend(c, kv) ->
+ proc.xstatus <- PSExec;
+ begin
+ if (int_of_kbval c) == 0 then
+ Format.printf "%s@." (kval_descr kv)
+ else
+ Queue.push kv (Hashtbl.find chans (int_of_kbval c))
+ end;
+ true
+ | PSRecv(c) ->
+ let q = Hashtbl.find chans (int_of_kbval c) in
+ if not (Queue.is_empty q) then
+ proc.xstatus <- PSExecRecvd (Queue.pop q);
+ true
+
+let exec_program p =
+ let proc0 = {
+ xspawn = spawn;
+ xnewchan = newchan;
+ xprog = p;
+ xvals = Smap.empty;
+ xstatus = PSExec;
+ xpos = 0
+ } in
+ proc0.xvals <- Smap.add framevar (VInt 0) proc0.xvals;
+ proc0.xvals <- Smap.add "stdout" (VInt 0) proc0.xvals;
+ proc := [ proc0 ];
+ while List.length !proc > 0 do
+ proc := List.filter proc_step !proc;
+ proc := !proc_spawned @ !proc;
+ proc_spawned := [];
+ done
+
+
diff --git a/_khb_experiment/ksh_print.ml b/_khb_experiment/ksh_print.ml
new file mode 100644
index 0000000..6b0a7e3
--- /dev/null
+++ b/_khb_experiment/ksh_print.ml
@@ -0,0 +1,53 @@
+open Khs_ast
+
+let rec expr_str = function
+ | EEmpty -> "()"
+ | EInt i -> string_of_int i
+ | EStr s -> "\"" ^ s ^ "\""
+ | EBool b -> if b then "true" else "false"
+ | EFrame -> "#"
+ | ELocal s -> "." ^ s
+ | EBinary (e1, op, e2) ->
+ "(" ^ expr_str e1 ^
+ (match op with
+ | PLUS -> " + "
+ | MINUS -> " - "
+ | TIMES -> " * "
+ | DIV -> " / "
+ | MOD -> " % "
+ | EQUAL -> " == "
+ | NEQUAL -> " != "
+ | GT -> " > "
+ | LT -> " < "
+ | GE -> " >= "
+ | LE -> " <= "
+ | AND -> " && "
+ | OR -> " || "
+ | XOR -> " ^^ "
+ ) ^ expr_str e2 ^ ")"
+ | EUnary (op, e) ->
+ (match op with
+ | MINUS -> "-"
+ | NOT -> "!"
+ ) ^ expr_str e
+ | ETernary(c, a, b) ->
+ "(" ^ expr_str c ^ " ? " ^ expr_str a ^ " : " ^ expr_str b ^ ")"
+ | ECat(x, y) -> expr_str x ^ "\\" ^ expr_str y
+ | ELoad(v) -> "@" ^ expr_str v
+ | ENewChan -> "<>"
+
+let print_stmt = function
+ | SLabel s -> Format.printf "%s:@." s
+ | SSet(k, v) -> Format.printf " %s := %s@." (expr_str k) (expr_str v)
+ | SGoto l -> Format.printf " < %s >@." (expr_str l)
+ | SPar l -> Format.printf " | %s |@." (expr_str l)
+ | SRecv (e, c) -> Format.printf " %s << %s@." (expr_str e) (expr_str c)
+ | SSend (e, c) -> Format.printf " %s >> %s@." (expr_str e) (expr_str c)
+ | SUnset l ->
+ let rec aux = function
+ | [] -> " ~("
+ | [a] -> " ~(" ^ (expr_str a)
+ | a::b -> (aux b) ^ ", " ^ (expr_str a)
+ in Format.printf "%s)@." (aux l)
+ | SExit ->
+ Format.printf " exit@."
diff --git a/_khb_experiment/test.khb b/_khb_experiment/test.khb
new file mode 100644
index 0000000..f109016
--- /dev/null
+++ b/_khb_experiment/test.khb
@@ -0,0 +1,67 @@
+$$ integers (n, nmax, qo) =
+ (n > nmax ?
+ (-1) >> qo
+ :
+ n >> qo;
+ become integers(n+1, nmax, qo)
+ )
+
+# Version alternative :
+$$ integers (n, nmax, qo) =
+ ]->[ (
+ (n > nmax ? ->[]);
+ n >> qo;
+ n = n + 1
+ );
+ -1 >> qo
+
+$$ filter (n, qi, qo) =
+ val << qi;
+ (val != -1 ?
+ (val % n != 0 ?
+ val >> qo
+ );
+ become filter(n, qi, qo)
+ :
+ -1 >> qo
+ )
+
+# Version alternative :
+$$ filter (n, qi, qo) =
+ ]->[ (
+ val << qi;
+ (val == -1 ? ->[]);
+ (val % n != 0 ? val >> qo)
+ );
+ -1 >> qo
+
+$$ primes (qi) =
+ val << qi;
+ (val != -1 ?
+ val >> stdout;
+ c = <>;
+ | become filter(val, qi, c.out) |;
+ become primes(c.in)
+ )
+
+# Version alternative :
+$$ primes (qi) =
+ ]->[ (
+ val << qi;
+ (val == -1 ? ->[]);
+ val >> stdout;
+ c = <>;
+ | filter(val, qi, c.out) |;
+ qi = c.in
+ )
+
+$$ main () =
+ c = <>;
+ | integers (2, 5000, c.out) |;
+ primes (c.in)
+
+
+
+
+
+
diff --git a/_khb_experiment/test.khs b/_khb_experiment/test.khs
new file mode 100644
index 0000000..54b9507
--- /dev/null
+++ b/_khb_experiment/test.khs
@@ -0,0 +1,76 @@
+proc_integers:
+ < @fd[f].n > @fd[f].nmax ? _then1 : _else1 >
+_then1:
+ -1 >> @fd[f].qo
+ < _end1 >
+_else1:
+ @fd[f].n >> @fd[f].qo
+ fd[f].trtmp.n := @fd[f].n + 1
+ fd[f].trtmp.nmax := @fd[f].nmax
+ fd[f].trtmp.qo := @fd[f].qo
+ fd[f].n := @fd[f].trtmp.n
+ fd[f].nmax := @fd[f].trtmp.nmax
+ fd[f].qo := @fd[f].trtmp.qo
+ < proc_integers >
+ < _end1 >
+_end1:
+ fd[f] := ""
+ ~ (.qo, .nmax, .n)
+ < @fd[f].return >
+
+ proc_filter:
+ val << @(fd\@f\qi)
+ < @val != -1 ? _then2 : _else2 >
+_then2:
+ < @val % @(fd\@f\n) != 0 ? _then3 : _end3 >
+_then3:
+ @val >> @(fd\@f\qo)
+_end3:
+ <proc_filter>
+ <_end2>
+_else2:
+ -1 >> @qo
+ <_end2>
+_end2:
+ fd[f] := ""
+ ~ (.qo, .qi, .val, .n)
+ < @(fd\@f\return) >
+
+proc_primes:
+ .val << @.qi
+ < @.val != -1 ? _then4 : _end4 >
+_then4:
+ @.val >> @stdout
+ .c := <>
+ | _par_1 |
+ .qi := @(.c\in)
+ <proc_primes>
+_end4:
+ fd\@f := ""
+ ~ (.val, .qi, .c)
+ < @(fd\@f\return) >
+_par_1:
+ .n := @.val
+ .qo := @(.c\out)
+ <proc_filter>
+
+proc_main:
+ .c := <>
+ | _par_2 |
+ fd\(@f+1)\qi := @(.c\in)
+ f := @f+1
+ .return := _ret1
+ <proc_primes>
+_ret1:
+ f := @f-1
+ .tmp_retval := @(fd\(@f+1))
+ fd\@f := .tmp_retval
+ ~(.tmp_retval)
+ < .return >
+_par_2:
+ .n := 2
+ .nmax := 5000
+ .qo := @(.c\out)
+ <proc_integers>
+
+
diff --git a/_khb_experiment/test.ml b/_khb_experiment/test.ml
new file mode 100644
index 0000000..edc155e
--- /dev/null
+++ b/_khb_experiment/test.ml
@@ -0,0 +1,101 @@
+open Khs_ast
+open Khs_exec
+
+let primes_khs = [|
+ SGoto (EStr "proc_main");
+
+ (* integers *)
+ SLabel "proc_integers";
+ SGoto (
+ ETernary(
+ EBinary(ELoad(ELocal "n"), GT, ELoad(ELocal "nmax")),
+ EStr "_then1", EStr "_else1"));
+
+ SLabel "_then1";
+ SSend(EInt (-1), ELocal "qo");
+ SGoto(EStr "_end1");
+
+ SLabel "_else1";
+ SSend(ELoad(ELocal "n"), ELocal "qo");
+ SSet(ELocal "n",
+ EBinary(ELoad(ELocal "n"), PLUS, EInt 1));
+ SGoto (EStr "proc_integers");
+
+ SLabel "_end1";
+ SSet(ELocal "retval", EEmpty);
+ SUnset [ELocal "qo"; ELocal "nmax"; ELocal "n"];
+ SGoto(ELoad(ELocal "retpos"));
+
+ (* filter *)
+ SLabel "proc_filter";
+ SRecv(ELocal "val", ELocal "qi");
+ SGoto(ETernary(
+ EBinary(ELoad(ELocal "val"), NEQUAL, EInt (-1)),
+ EStr "_then2", EStr "_else2"));
+
+ SLabel "_then2";
+ SGoto(ETernary(
+ EBinary(EBinary(ELoad(ELocal "val"), MOD, ELoad(ELocal "n")), NEQUAL, EInt 0),
+ EStr "_then3", EStr "_end3"));
+
+ SLabel "_then3";
+ SSend(ELoad(ELocal "val"), ELocal "qo");
+
+ SLabel "_end3";
+ SGoto(EStr "proc_filter");
+
+ SLabel "_else2";
+ SSend(EInt (-1), ELocal "qo");
+
+ SSet(ELocal "retval", EEmpty);
+ SUnset[ELocal "qo"; ELocal "qi"; ELocal "val"; ELocal "n"];
+ SGoto(ELoad(ELocal "retpos"));
+
+ (* primes *)
+ SLabel "proc_primes";
+ SRecv(ELocal "val", ELocal "qi");
+ SGoto(ETernary(
+ EBinary(ELoad(ELocal "val"), NEQUAL, EInt(-1)),
+ EStr "_then4", EStr "_end4"));
+
+ SLabel "_then4";
+ SSend(ELoad(ELocal "val"), EStr "stdout");
+ SSet(ELocal "c", ENewChan);
+ SPar(EStr "_par_1");
+ SSet(ELocal "qi", ELoad(ECat(ELocal "c", EStr "in")));
+ SGoto(EStr "proc_primes");
+
+ SLabel "_end4";
+ SSet(ELocal "retval", EEmpty);
+ SUnset[ELocal "qi"; ELocal "val"; ELocal "c"];
+ SGoto(ELoad(ELocal "retpos"));
+
+ SLabel "_par_1";
+ SSet(ELocal "n", ELoad(ELocal "val"));
+ SSet(ELocal "qo", ELoad(ECat(ELocal "c", EStr "out")));
+ SGoto(EStr "proc_filter");
+
+
+ (* main *)
+ SLabel "proc_main";
+ SSet(ELocal "c", ENewChan);
+ SPar(EStr "_par_2");
+
+ SSet(ELocal "qi", ELoad(ECat(ELocal "c", EStr "in")));
+ SSet(ELocal "retpos", EStr "_ret1");
+ SGoto(EStr "proc_primes");
+
+ SLabel "_par_2";
+ SSet(ELocal "n", EInt 2);
+ SSet(ELocal "nmax", EInt 3000);
+ SSet(ELocal "qo", ELoad(ECat(ELocal "c", EStr "out")));
+ SSet(ELocal "retpos", EStr "_ret1");
+ SGoto(EStr "proc_integers");
+
+ SLabel "_ret1";
+ SExit;
+|]
+
+let () =
+ Array.iter Ksh_print.print_stmt primes_khs;
+ Khs_exec_local.exec_program (load_program primes_khs)
diff --git a/_khb_experiment/util.ml b/_khb_experiment/util.ml
new file mode 100644
index 0000000..0d278d6
--- /dev/null
+++ b/_khb_experiment/util.ml
@@ -0,0 +1,10 @@
+
+module Int = struct
+ type t = int
+ let compare = Pervasives.compare
+end
+
+module Smap = Map.Make(String)
+module Imap = Map.Make(Int)
+
+let (^^) a b = (a || b) && (not (a && b))