diff --git a/model_with_structures/synthesizer.ml b/model_with_structures/synthesizer.ml index 31a1e70..cc6f730 100644 --- a/model_with_structures/synthesizer.ml +++ b/model_with_structures/synthesizer.ml @@ -167,7 +167,7 @@ struct [%%ocanren_inject type nonrec ('sl, 'd, 'vl) t = ZeroV | SmthV | BotV | FunV of 'sl | RefV of 'd | TupleV of 'vl [@@deriving gt ~options:{ show; gmap }] - type ground = ((Nat.ground List.ground * Stmt.ground) List.ground, Nat.ground, ground List.ground) t + type ground = (((* Nat.ground List.ground * *) Stmt.ground) List.ground, Nat.ground, ground List.ground) t ] end @@ -814,8 +814,8 @@ struct s == CallS (f, es) & pathvalo mem vals f v & pathtypeo types f tp & - types' == TypesEnv [] & - vals' == ValsEnv [] & + types' == TypesEnv [] & (* TODO: FIXME add globals *) + vals' == ValsEnv [] & (* TODO: FIXME add globals *) v == FunV fstmts & tp == FunT tps & st' == StEnv (mem, types', vals') & @@ -867,9 +867,12 @@ struct let prog_evalo prog st' = let open Prg in + let open Stmt in ocanren { - fresh decls, s, init_st in + fresh decls, s, init_st in prog == Prg (decls, s) & + decls == [] & + s == SkipS & prog_inito prog init_st & stmt_evalo init_st s st' } diff --git a/model_with_structures/tests.ml b/model_with_structures/tests.ml index 674f35c..bf6b1bd 100644 --- a/model_with_structures/tests.ml +++ b/model_with_structures/tests.ml @@ -2,6 +2,8 @@ open Tests_f open Synthesizer open Relational +let%expect_test "prog eval test 1" = print_endline (prog_eval_t1 ()); [%expect {| [StEnv (MemEnv ([], O), TypesEnv ([]), ValsEnv ([]))] |}] + (* type tests *) (* let%expect_test "Tag type test" = print_endline (Tag.Test.test ()); [%expect {| [Tag (Rd, NeverWr, Ref, In, NOut)] |}] *) (* let%expect_test "Stmt type test (1)" = print_endline (Stmt.Test.test1 ()); [%expect {| [[S (S (O))]] |}] *) diff --git a/model_with_structures/tests_f.ml b/model_with_structures/tests_f.ml index 093ced7..6737d97 100644 --- a/model_with_structures/tests_f.ml +++ b/model_with_structures/tests_f.ml @@ -4,7 +4,17 @@ open GT open OCanren open OCanren.Std -(* @type answer = St.ground GT.list with show *) +@type answer = StEnv.ground GT.list with show + +let prog_eval_t1 _ = show(answer) (Stream.take (run q + (fun q -> let open Prg in + let open Stmt in + ocanren { + fresh prog in + prog == Prg ([], SkipS) & + prog_evalo prog q}) + (fun q -> q#reify (StEnv.prj_exn)))) + (* @type answerArgs = (Arg.ground List.ground) GT.list with show *) (* @type answerValue = Value.ground GT.list with show *) (* @type answerNat = Nat.ground GT.list with show *)