module Jog = struct
open Zone
exception OffTrack of int
type qnAcc = fray nAcc
type tap = qnAcc -> qnAcc
type tapl = (int list * (tap * tap)) list
let (nop : tap) = (fun t -> t)
let init = ref {ray = (fun _ _ -> raise (OffTrack 1));
     curl = (fun _ -> raise (OffTrack 1))}
let (nop1 : tap) = (fun t -> init := t; t)
(* let (nop2 : tap) = (fun {ray = r; curl = c} -> {ray = r; curl = c})
let (peek : tap) = (fun {ray = r; curl = c} ->
   {ray = (fun fl fa -> print_float fl; r fl fa); curl = c})
let (nudge : tap) = (fun {ray = r; curl = c} ->
   {ray = (fun fl -> r (fl +. 0.01)); curl = c}) *)

let nz ds2 vl =
  let v = Array.of_list vl in let np = (len v) - 1 in
  let neigh = (aini (np+1) (fun j ->
    {ray = (fun lam dzray -> raise (OffTrack 0)); 
     curl = (fun (_, x) ->
        print_string "un-monitored boundary"; x)})) in
((fun fn ex -> neigh.(fn) <- ex),
 (newz (aini (np+1) (fun i -> aini (np+1) (fun j -> ds2 v.(i) v.(j))))
     neigh (fun a -> pzl a vl)))

let mix (top, blf) perm = let pl = List.map (fun v -> perm.(v)) in 
   List.map pl top, (fun i j -> blf (perm.(i)) (perm.(j))),
   List.map (fun (vl, tps) -> sort (<) (pl vl), tps)

exception Short
let ap f lst = try (match lst with [a; b] -> f a b) with Match_failure s -> raise Short
let exc al alt arg = let r = (ap alt) arg in try
  let s = List.assoc (sort (<) arg) al in print_string "substitute "; print_float s;
  print_string " for "; print_float r; print_string " case:"; pzl "x" arg; s
  with Not_found -> r

end;;