Lisa fixpoint

Author: sim642

src/fixpoint/dune

@@ -0,0 +1,3 @@
+(library
+ (name fixpoint)
+ (preprocess (pps ppx_deriving.std)))

src/fixpoint/fixpoint.ml

@@ -0,0 +1,28 @@
+(** Püsipunktid.
+
+    Vt. "Introduction to Compiler Design" õpikust, peatükk 1.5.1.
+    Vt. Vesali "The Sulund Design Pattern™" slaide. *)
+
+(** Püsipunktid üle suvalise võrreldava tüübi. *)
+module Make (D: sig type t [@@deriving eq] end) =
+struct
+  (** Leiab funktsiooni püsipunkti alustades iteratsiooni antud väärtusest. *)
+  let fp (f: D.t -> D.t) (initial: D.t): D.t =
+    failwith "TODO"
+end
+
+(** Püsipunktid üle hulkade. *)
+module MakeSet (D: Set.S) =
+struct
+  include Make (D)
+
+  (** Leiab funktsiooni vähima püsipunkti.
+      Kasutada fp funktsiooni. *)
+  let lfp (f: D.t -> D.t): D.t =
+    failwith "TODO"
+
+  (** Leiab funktsiooni sulundi, mis sisaldab antud väärtusi.
+      Kasutada lfp funktsiooni. *)
+  let closure (f: D.t -> D.t) (initial: D.t): D.t =
+    failwith "TODO"
+end

test/fixpoint/dune

@@ -0,0 +1,4 @@
+(test
+ (name fixpoint_test)
+ (libraries ounit2 ounittodo fixpoint)
+ (preprocess (pps ppx_deriving.std)))

test/fixpoint/fixpoint_test.ml

@@ -0,0 +1,9 @@
+open OUnit2
+
+let tests =
+  "fixpoint" >::: [
+    Transition_test.tests;
+    Nfa_eps_test.tests;
+  ]
+
+let () = run_test_tt_main (OUnitTodo.wrap tests)

test/fixpoint/nfa_eps_test.ml

@@ -0,0 +1,61 @@
+(** Epsilonsulundi näide "Introduction to Compiler Design" õpikust, peatükk 1.5.1. *)
+open OUnit2
+open Fixpoint
+
+module IntSet = Set.Make (Int)
+
+let show_intset is = [%show: int list] (IntSet.elements is)
+
+(** Epsilonsammude funktsioon, joonis 1.5. *)
+let nfa_eps = function
+  | 1 -> [2; 5]
+  | 5 -> [6; 7]
+  | 8 -> [1]
+  | _ -> []
+
+(** Epsilonsammude funktsioon hulgal. *)
+let nfa_eps_set states =
+  IntSet.elements states
+  |> List.concat_map nfa_eps
+  |> IntSet.of_list
+
+module IntSetFP = MakeSet (IntSet)
+
+let assert_equal = assert_equal ~cmp:IntSet.equal ~printer:show_intset
+
+let test_fp _ =
+  (* Olekust 1. *)
+  let f1 x = IntSet.union (IntSet.singleton 1) (nfa_eps_set x) in
+  assert_equal (IntSet.of_list [1; 2; 5; 6; 7]) (IntSetFP.fp f1 IntSet.empty);
+  (* Olekust 2. *)
+  let f2 x = IntSet.union (IntSet.singleton 2) (nfa_eps_set x) in
+  assert_equal (IntSet.of_list [2]) (IntSetFP.fp f2 IntSet.empty);
+  (* Olekust 8. *)
+  let f8 x = IntSet.union (IntSet.singleton 8) (nfa_eps_set x) in
+  assert_equal (IntSet.of_list [1; 2; 5; 6; 7; 8]) (IntSetFP.fp f8 IntSet.empty)
+
+let test_lfp _ =
+  (* Olekust 1. *)
+  let f1 x = IntSet.union (IntSet.singleton 1) (nfa_eps_set x) in
+  assert_equal (IntSet.of_list [1; 2; 5; 6; 7]) (IntSetFP.lfp f1);
+  (* Olekust 2. *)
+  let f2 x = IntSet.union (IntSet.singleton 2) (nfa_eps_set x) in
+  assert_equal (IntSet.of_list [2]) (IntSetFP.lfp f2);
+  (* Olekust 8. *)
+  let f8 x = IntSet.union (IntSet.singleton 8) (nfa_eps_set x) in
+  assert_equal (IntSet.of_list [1; 2; 5; 6; 7; 8]) (IntSetFP.lfp f8)
+
+let test_closure _ =
+  (* Olekust 1. *)
+  assert_equal (IntSet.of_list [1; 2; 5; 6; 7]) (IntSetFP.closure nfa_eps_set (IntSet.singleton 1));
+  (* Olekust 2. *)
+  assert_equal (IntSet.of_list [2]) (IntSetFP.closure nfa_eps_set (IntSet.singleton 2));
+  (* Olekust 8. *)
+  assert_equal (IntSet.of_list [1; 2; 5; 6; 7; 8]) (IntSetFP.closure nfa_eps_set (IntSet.singleton 8))
+
+let tests =
+  "nfa_eps" >::: [
+    "fp" >:: test_fp;
+    "lfp" >:: test_lfp;
+    "closure" >:: test_closure;
+  ]

test/fixpoint/nfa_eps_test.mli

@@ -0,0 +1 @@
+val tests: OUnit2.test

test/fixpoint/transition_test.ml

@@ -0,0 +1,70 @@
+(** Transitiivse sulundi näide Vesali "The Sulund Design Pattern™" slaididelt. *)
+open OUnit2
+open Fixpoint
+
+module Transition =
+struct
+  type t = int * string * int [@@deriving ord, show]
+end
+
+module TransitionSet =
+struct
+  include Set.Make (Transition) (* Taaskasutame standardset hulga moodulit. *)
+  (* Aga lisame mõne funktsiooni juurde. *)
+
+  (** Relatsioonide kompositsioon. *)
+  let compose rel1 rel2 =
+    fold (fun (s1, l1, t1) acc ->
+        fold (fun (s2, l2, t2) acc ->
+            if t1 = s2 then
+              add (s1, l1 ^ l2, t2) acc
+            else
+              acc
+          ) rel2 acc
+      ) rel1 empty
+
+  let show ts = [%show: Transition.t list] (elements ts)
+end
+
+(** Algne relatsioon. *)
+let initial = TransitionSet.of_list [
+  (0, "a", 1);
+  (1, "b", 2);
+  (1, "c", 3);
+  (3, "d", 4);
+]
+
+(** Oodatav transitiivne sulund. *)
+let expected = TransitionSet.of_list [
+  (0, "a", 1);
+  (1, "b", 2);
+  (1, "c", 3);
+  (3, "d", 4);
+  (0, "ab", 2);
+  (0, "ac", 3);
+  (1, "cd", 4);
+  (0, "acd", 4);
+]
+
+module TransitionSetFP = MakeSet (TransitionSet)
+
+let assert_equal = assert_equal ~cmp:TransitionSet.equal ~printer:TransitionSet.show
+
+let test_fp _ =
+  let f ts = TransitionSet.union initial (TransitionSet.compose ts initial) in
+  assert_equal expected (TransitionSetFP.fp f TransitionSet.empty)
+
+let test_lfp _ =
+  let f ts = TransitionSet.union initial (TransitionSet.compose ts initial) in
+  assert_equal expected (TransitionSetFP.lfp f)
+
+let test_closure _ =
+  let f ts = TransitionSet.compose ts initial in
+  assert_equal expected (TransitionSetFP.closure f initial)
+
+let tests =
+  "transition" >::: [
+    "fp" >:: test_fp;
+    "lfp" >:: test_lfp;
+    "closure" >:: test_closure;
+  ]

test/fixpoint/transition_test.mli

@@ -0,0 +1 @@
+val tests: OUnit2.test