type ray = Towards | Away ;;
type color = None | Med | All ;;
let ( ++ ) a b =
  match a,b with
    | None,None -> None
    | Med,None -> Med
    | None,Med -> Med
    | _ -> All
;;
let ( ** ) a b =
  match a,b with
    | None,_
    | _,None -> None
    | Med,_
    | _,Med -> Med
    | _ -> All
;;
[[None ** None;None ** Med;None ** All];
 [Med ** None;Med ** Med;Med ** All];
 [All ** None;All ** Med;All ** All]];;

[[None ++ None;None ++ Med;None ++ All];
 [Med ++ None;Med ++ Med;Med ++ All];
 [All ++ None;All ++ Med;All ++ All]];;

let rec ray ls ri =
  match ls with
    | [] -> None
    | (d,r,t,e)::tl ->
        if d = Towards then
          (r**ri)
          ++(t**(ray tl (mir ls ri)))
          ++e
        else
          ray tl (mir ls ri )
and mir ls ri =
  let (d,r,t,e) = List.hd ls in
    if d = Away then
      (r**(ray (List.tl ls) ri ))
      ++(t**ri)
      ++e
    else
      ri
;;

ray [(Towards,Med,All,Med);
     (Away,None,None,None);
     (Towards,All,None,None);
     (Away,All,Med,All);
     (Towards,Med,All,Med);
     (Towards,Med,Med,None)] None ;;

ray [(Away   , All,  None, None);
     (Towards, Med,  Med,  All);
     (Away   , All,  Med,  Med);
     (Towards, All,  All,  All);
     (Away   , All,  None, All);
     (Towards, All,  All,  All);
     (Away   , None, None, All);
     (Towards, Med,  All,  None);
     (Away   , All,  None, Med)] None ;;

ray [(Away   , All,  None,Med );
     (Towards, None, Med, None);
     (Away   , All,  All, All );
     (Towards, None, Med, None);
     (Away   , None, All, None);
     (Towards, None, Med, None);
     (Away   , All,  All, Med );
     (Towards, Med,  All, None)] None ;;

ray [(Away   , None,Med,Med );
     (Towards, All, All,All );
     (Away   , Med, Med,Med );
     (Towards, All,None,All );
     (Away   , Med, All,All );
     (Towards, None,Med,None);
     (Away   , Med, Med,None)] None ;;


ray [(Away   , Med,  None, None);
     (Towards, All,  Med,  None);
     (Away   , Med,  All,  All );
     (Towards, None, All,  All );
     (Away   , None, None, All );
     (Towards, None, All,  All );
     (Away   , Med,  All,  Med );
     (Towards, None, All,  Med );
     (Away   , None, None, None)] None ;;

ray [(Away   , Med,  Med, All );
     (Towards, All,  None,None);
     (Away   , Med,  None,None);
     (Towards, None, All, All );
     (Away   , Med,  All, All )] None ;;