Pretty good version

This commit is contained in:
Calascibetta Romain 2024-12-08 18:43:14 +01:00
parent d12818ce05
commit d0f9ddad5e
3 changed files with 0 additions and 18 deletions

View file

@ -98,9 +98,7 @@ and ('k, 'res) devices =
let net name = Net name let net name = Net name
let block name = Block name let block name = Block name
let opt arg = Args [ arg ]
let map _fn args = Args args let map _fn args = Args args
let dft _v arg = Args [ arg ]
let const _ = Args [] let const _ = Args []
type t = [ `Block of string | `Net of string ] type t = [ `Block of string | `Net of string ]

View file

@ -190,8 +190,6 @@ type ('k, 'res) devices =
val net : string -> (Net.t * Net.cfg) arg val net : string -> (Net.t * Net.cfg) arg
val block : string -> Block.t arg val block : string -> Block.t arg
val opt : 'a arg -> 'a option arg
val map : 'f -> ('f, 'a) devices -> 'a arg val map : 'f -> ('f, 'a) devices -> 'a arg
val dft : 'a -> 'a arg -> 'a arg
val const : 'a -> 'a arg val const : 'a -> 'a arg
val run : ?g:Random.State.t -> ('a, 'b) devices -> 'a -> 'b val run : ?g:Random.State.t -> ('a, 'b) devices -> 'a -> 'b

View file

@ -508,8 +508,6 @@ type 'a arg =
| Net : string -> (Net.t * Net.cfg) arg | Net : string -> (Net.t * Net.cfg) arg
| Block : string -> Block.t arg | Block : string -> Block.t arg
| Map : ('f, 'a) devices * 'f -> 'a arg | Map : ('f, 'a) devices * 'f -> 'a arg
| Opt : 'a arg -> 'a option arg
| Dft : 'a * 'a arg -> 'a arg
| Const : 'a -> 'a arg | Const : 'a -> 'a arg
and ('k, 'res) devices = and ('k, 'res) devices =
@ -518,9 +516,7 @@ and ('k, 'res) devices =
let net name = Net name let net name = Net name
let block name = Block name let block name = Block name
let opt value = Opt value
let map fn args = Map (args, fn) let map fn args = Map (args, fn)
let dft v arg = Dft (v, arg)
let const v = Const v let const v = Const v
let rec ctor : type a. a arg -> a = function let rec ctor : type a. a arg -> a = function
@ -534,17 +530,7 @@ let rec ctor : type a. a arg -> a = function
| Ok t -> t | Ok t -> t
| Error (`Msg msg) -> failwithf "%s." msg | Error (`Msg msg) -> failwithf "%s." msg
end end
| Opt arg -> begin
match go (fun fn -> fn ()) [ arg ] (fun v () -> Some v) with
| v -> v
| exception _ -> None
end
| Const v -> v | Const v -> v
| Dft (v, arg) -> begin
match go (fun fn -> fn ()) [ arg ] (fun v () -> v) with
| v' -> v'
| exception _ -> v
end
| Map (args, fn) -> go (fun fn -> fn ()) args fn | Map (args, fn) -> go (fun fn -> fn ()) args fn
and go : type k res. ((unit -> res) -> res) -> (k, res) devices -> k -> res = and go : type k res. ((unit -> res) -> res) -> (k, res) devices -> k -> res =