From 1c74f0c3efbe8acfd5cc4ebd91c9f4ae75cad74c Mon Sep 17 00:00:00 2001 From: ProgramSnail Date: Tue, 9 Dec 2025 16:40:20 +0300 Subject: [PATCH] interpretera, logic & abstract types draft, fixes --- bin/main.ml | 4 +- dune-project | 2 +- lib/lib.ml | 110 ++++++++++++++++++++++++++++++++++- lib/lib_next.ml | 2 +- pass_strategy_synthesis.opam | 2 +- 5 files changed, 112 insertions(+), 8 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 693aac2..e708cc0 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -1,4 +1,4 @@ -open OCanren -open Lib +(* open OCanren *) +(* open Lib *) let () = print_endline "Hello, World!" diff --git a/dune-project b/dune-project index 21d5a54..385e818 100644 --- a/dune-project +++ b/dune-project @@ -21,7 +21,7 @@ (description "A longer description") (depends (ocaml - (= 4.14.2)) + (= 5.3.0)) GT (OCanren (>= 0.3.0~)) diff --git a/lib/lib.ml b/lib/lib.ml index 97f6ca6..cf0e8ea 100644 --- a/lib/lib.ml +++ b/lib/lib.ml @@ -2,12 +2,116 @@ open OCanren type data = int -type tag = Ref | Value +type tag = Ref | ConstRef | Value type stmt = Call of data * data list | Read of data | Write of data type body = stmt list -type arg = data * tag -type fun_decl = data * arg list * body +type fun_decl = tag list * body type prog = fun_decl list * body + +(* --- interpreter --- *) + +(* +init vals values: 0 +write: ++value +read: print value with name +*) + +module M = Map.Make (Int);; + +let read_var env id = env.(id);; +let inc_var env id = env.(id) <- env.(id) + 1; env;; +let replace_var env id value = env.(id) <- value; env;; + +let apply_env f_env args env = + List.fold_left2 replace_var env args (Array.to_list f_env);; + +let rec eval_stmt env prog stmt = + match stmt with + | Call (f_id, args) -> eval_fun env prog (List.nth prog f_id) args + | Read id -> Printf.printf "var.%i = %i\n" id @@ read_var env id; env + | Write id -> inc_var env id + +and eval_body env prog body = List.fold_left (fun env stmt -> eval_stmt env prog stmt) env body + +and eval_fun env prog decl args = + match decl with (arg_tags, body) -> + let f_env = Array.map (fun x -> read_var env x) @@ Array.of_list args in + let f_env_result = eval_body f_env prog body in + apply_env f_env_result args env;; + +(* --- abstracted types --- *) + +type 'a a_stmt = ACall of 'a * 'a list | ARead of 'a | AWrite of 'a +type 'stmt a_body = 'stmt list +type ('id, 'stmt) a_fun_decl = 'id list * 'stmt a_body +type ('fun_decl, 'body) a_prog = 'fun_decl list * 'body + +(* --- logic types --- *) + +type l_data = Std.Nat.logic +type l_tag = tag ilogic +type l_stmt = l_data a_stmt ilogic +type l_body = l_data a_stmt ilogic +type l_fun_decl = (l_data, l_stmt) a_fun_decl ilogic +type l_prog = (l_fun_decl, l_body) a_prog ilogic + +(* --- relational verifier --- *) + +(* TODO *) + +(* --- comments --- *) + +(* +>> ref | const ref | copy: + +-> write into the arg => != const ref + +-> call function with ref => != const ref + +-> read var right after function call (no write between) => != ref + +-> call function on var right after function call (no write between) => != ref + +// TODO: check that vvar used to read before write inside? <- probably could be assumed correct +// TODO: intruduce Unused tag ? + +------ + +>> :ref | copy: +write argument in function & write after any function call => !ref +call function with arg ref that modifies & write after any function call => !ref + +*) + +(* TODO: example *) +(* module Tree = struct *) + (* ocanren type 'a tree = Leaf | Node of 'a * 'a tree * 'a tree *) + + (* type inttree = GT.int tree [@@deriving gt ~options:{show}] *) + (* A shortcut for "ground" tree we're going to work with in "functional" code *) + (* type rtree = Std.Nat.ground tree [@@deriving gt ~options:{show}] *) + + (* Logic counterpart *) + (* type ltree = Std.Nat.logic tree_logic [@@deriving gt ~options:{show}] *) + + (* let leaf () : Std.Nat.injected tree_injected = inj Leaf *) + (* let node a b c : Std.Nat.injected tree_injected = inj @@ Node (a,b,c) *) + + (* Injection *) + (* let rec inj_tree : inttree -> Std.Nat.injected tree_injected = fun tree -> *) + (* inj @@ GT.(gmap tree_fuly Std.nat inj_tree tree) *) + + (* Projection *) + (* let rec prj_tree : rtree -> inttree = *) + (* fun eta -> GT.(gmap tree_fuly) Std.Nat.to_int prj_tree eta *) + + (* let reify_tree : (Std.Nat.injected tree_injected, ltree) Reifier.t = *) + (* tree_reify Std.Nat.reify *) + + (* let prj_exn_tree : (Std.Nat.injected tree_injected, inttree) Reifier.t = *) + (* let rec tree_to_int x = GT.gmap tree_fuly Std.Nat.to_int (tree_to_int) x in *) + (* Reifier.fmap tree_to_int (tree_prj_exn Std.Nat.prj_exn) *) +(* end *) diff --git a/lib/lib_next.ml b/lib/lib_next.ml index a780b90..9fbe4b4 100644 --- a/lib/lib_next.ml +++ b/lib/lib_next.ml @@ -69,7 +69,7 @@ let init_state prog = { s_func = prog.p_func |> List.to_seq |> M.of_seq; (* s_value = UnitV; *) };; -let find_func name state = M.find_opt name state.s_func +let find_func name state = M.find_opt name state.s_func;; let find_frame_var name frame = M.find_opt name frame.f_vars;; let rec find_frames_var name frames = diff --git a/pass_strategy_synthesis.opam b/pass_strategy_synthesis.opam index 03368cf..ef2cc27 100644 --- a/pass_strategy_synthesis.opam +++ b/pass_strategy_synthesis.opam @@ -11,7 +11,7 @@ doc: "https://url/to/documentation" bug-reports: "https://github.com/username/reponame/issues" depends: [ "dune" {>= "3.20"} - "ocaml" {= "4.14.2"} + "ocaml" {= "5.3.0"} "GT" "OCanren" {>= "0.3.0~"} "OCanren-ppx" {>= "0.3.0~"}