Init system sketchesinit

3 files changed, 171 insertions, 0 deletions

diff --git a/bin/dune b/bin/dune
new file mode 100644
index 0000000..3010ddf
--- /dev/null
+++ b/bin/dune
@@ -0,0 +1,6 @@
+(executable
+ (name sandbox)
+ (public_name sandbox)
+ (modules sandbox)
+ (libraries rnt)
+ (modes exe))
diff --git a/bin/sandbox.ml b/bin/sandbox.ml
new file mode 100644
index 0000000..2aa3763
--- /dev/null
+++ b/bin/sandbox.ml
@@ -0,0 +1,101 @@
+[@@@warning "-26-27-32-34-37-69"]
+open Rnt
+
+type ('a, 'b) service = { name: string; id: ('a * 'b) Type.Id.t }
+
+let service name = { name; id = Type.Id.make () }
+
+type ('a, 'b) component =
+  { provides: ('a, 'b) service;
+    value: 'a;
+    mount: 'a -> 'b -> (('a, 'b) component, Concepts.Condition.condition) result;
+    unmount: 'a -> 'b -> (('a, 'b) component, Concepts.Condition.condition) result;
+    requires: ('a, 'b) service BatSet.t;
+    extends: 'a extension BatSet.t }
+and 'a extension =
+  Extension: { target: ('c, 'd) service;
+               apply: 'a -> ('d, Concepts.Condition.condition) result } -> 'a extension
+
+type entry = Entry: ('a, 'b) component -> entry
+
+let entry_id (Entry { provides = { id; _ }; _ }) = Type.Id.uid id
+
+let entry_dependencies (Entry { extends; _ }) =
+  BatSet.enum extends
+  |> BatEnum.map (fun (Extension { target = { id; _ }; _ }) -> Type.Id.uid id)
+
+let toposort es =
+  let components =
+    BatFingerTree.enum es
+    |> BatEnum.map (fun entry -> (entry_id entry), entry)
+    |> BatMap.of_enum
+  in
+  let edges =
+    BatMap.enum components
+    |> BatEnum.map (fun (id, e) -> entry_dependencies e |> BatEnum.map (fun e -> id, e))
+    |> BatEnum.flatten
+    |> BatFingerTree.of_enum
+  in
+  let in_edges =
+    edges
+    |> Utilities.FingerTree.group (fun (_, t1) (_, t2) -> t1 - t2)
+    |> BatFingerTree.map (fun es ->
+           let _, t = BatFingerTree.head_exn es in
+           t, BatFingerTree.map (fun (x, y) -> y, x) es)
+    |> BatFingerTree.enum
+    |> BatMap.of_enum
+  in
+  let degree_of v = BatMap.find_opt v in_edges |> Option.fold ~none:0 ~some:BatFingerTree.size in
+  (* let queue = *)
+  (*   BatMap.values in_edges *)
+  (*   |> BatEnum.filter (fun v -> degree_of v) *)
+  (* in *)
+  failwith "TODO"
+
+let instantiate : entry BatFingerTree.t -> (entry BatFingerTree.t, Concepts.Condition.condition) result =
+  fun es ->
+  let es' = toposort es in
+  failwith "TODO"
+
+(* to instantiate the component tree:
+   - sort the list of components such that the dependents come before their dependencies, with the leaves coming first
+   - fold over this list, applying extensions, then merging the resulting extensions into the current set of extensions
+   - at the end, if the set of extensions contains anything other than the root, there are unmet dependencies on the tree
+ *)
+
+
+
+open Protocols
+
+let root = service "root"
+
+type subsystem = { name : string; root : Handle.t }
+
+let subsystem_manager : (Handle.t, subsystem) service = service "subsystem-manager"
+
+type health = Healthy | Unhealthy
+
+type health_check = unit -> health
+
+let health_manager : (unit, health_check) service = service "health-manager"
+
+let sakura : (unit, unit) component =
+  { provides = service "sakura";
+    value = ();
+    mount = (fun _ _ -> failwith "not extensible");
+    unmount = (fun _ _ -> failwith "not extensible");
+    requires = BatSet.empty;
+    extends = BatSet.of_list [Extension { target = subsystem_manager;
+                                          apply = (fun h ->
+                                            let root = failwith "nop" in
+                                            Ok { name = "sakura";
+                                                 root = root })};
+                              Extension { target = health_manager;
+                                          apply = (fun _ -> Ok (fun () -> Healthy))}] }
+
+
+
+(* type ('a, 'b) service = Root *)
+(* let root : (unit, unit) service = Root *)
+
+let () = print_endline "hello."
diff --git a/docs/init.org b/docs/init.org
new file mode 100644
index 0000000..746ce03
--- /dev/null
+++ b/docs/init.org
@@ -0,0 +1,64 @@
+The init system is the part of RNT responsible from taking a description of what a live system should look like and instantiating a system that matches this description, constructing and connecting different components as necessary. It is not a supervisor, that is, it is not responsible for maintaining the state of the system once it has been built, although it provides functionality that could support the implementation of a supervisor.
+
+More concretely, the role of the init system is to build a *system* out of a set of *components*. *Components* are the description of a building block of systems that can either require *services* from an existing component, extend an existing component and provide services to other components. A component that extends another component implicitly requires that component. Components, through this provision and requirement relationship, form a directed acyclic graph. Concretely, a component might look something like this:
+
+#+begin_src ocaml
+type service = ..
+
+type component =
+  { provides: service BatSet.t;
+    requires: service BatSet.t;
+    (* extends: extension list; *)
+    construct: (service, Handle.t) BatMap.t -> (Handle.t, Concepts.Condition.condition) result }
+
+
+
+module type SUBSYSTEM = struct
+  type t
+  val create : unit -> t
+  val destroy : t -> unit
+end
+
+module MySubsystem : SUBSYSTEM = struct
+
+end
+
+
+
+type ('a, 'b) service = ..
+
+type ('a, 'b) service += ServiceThatTakesAnInt
+let makeServiceThatTakesAnInt : int service = ServiceThatTakesAnInt
+
+type ('a, 'b) extension = ('a, 'b) service * ('a -> ('b, Concepts.Condition.condition) result)
+
+type component =
+  { provides: service;
+    extends: extension BatSet.t
+    extend: ()}
+
+let _ = Component.make
+	      ~provides:MySubsystem
+          ~extends:[extend Subsystem (fun h ->
+                        MySubsystem.make <><>)]
+
+let _ = Component.make
+	      ~requires:[SubsystemRegistry]
+          ~provides:[MySubsystem]
+          ~mount:(fun h ->
+            let myself = MySubstystem.make <><> in
+            SubssystemRegistry.register myself;
+            myself)
+          ~unmount:(fun h myself ->
+            Lifecycle.destroy myself)
+
+(* options:
+   - object destroy itself on unmount through lifecycles
+     - would require us to be able to notify the owner, which would mean we have to know who the owner is
+ ,*)
+
+
+
+type component =
+  { ex}
+#+end_src