Pretty good version
This commit is contained in:
parent
d12818ce05
commit
d0f9ddad5e
3 changed files with 0 additions and 18 deletions
|
@ -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 ]
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 =
|
||||||
|
|
Loading…
Reference in a new issue