多相的ヴァリアントとデータ構造とパターンマッチ

練習問題を解いたら結構長いコードになった。せっかくなので、記念カキコ。
作って満足してしまった。動作確認はまた今度。

(* 図形を定義 *)
type figure =
  Point
| Circle of float
| Rectangle of float * float
| Square of float;;

(* 座標情報をもったデータ *)
type 'a with_location = {loc_x : float; loc_y : float; body: 'a};;

type vector = Vector of float * float;;

(* 図形同士が重なっているかを判定*)
let rec overlap fig1 fig2 = 
  let (^-) p1 p2 = Vector (p1.loc_x -. p2.loc_x, p1.loc_y -. p2.loc_y) in
  let contains rect point =
    let Rectangle (w, h) = rect.body in
    let Vector (dx, dy) = point ^- rect in
    abs_float dx < w /. 2. && abs_float (dy) < h /. 2.
  in
  let dist p1 p2 = 
    let Vector (dx, dy) = p2 ^- p1 in
    sqrt (dx *. dx +. dy *. dy)
  in
  let get_nearest rect point =
    let Rectangle (w, h) = rect.body in
    let Vector (dx, dy) = point ^- rect in
    let w' = w /. 2. and h' = h /. 2. in
    {loc_x = if      dx >   w' then rect.loc_x +. w'
             else if dx < -.w' then rect.loc_x -. w'
             else point.loc_x;
     loc_y = if      dy >   h' then rect.loc_y +. h'
             else if dy < -.h' then rect.loc_y -. h'
             else point.loc_y;
     body = Point}
  in
  match (fig1.body, fig2.body) with
    (_, Square x) -> overlap fig1 {fig2 with body = Rectangle (x, x)}
  | (Point, Point) -> fig1.loc_x = fig2.loc_x && fig1.loc_y = fig2.loc_y
  | (Point, Circle r) -> dist fig1 fig2 < r
  | (Point, Rectangle _) -> contains fig2 fig1
  | (Circle r1, Circle r2) -> dist fig1 fig2 <= r1 +. r2
  | (Circle r, Rectangle _) -> dist (get_nearest fig2 fig1) fig1 < r
  | (Rectangle _, Rectangle _) -> contains (get_nearest fig2 fig1) fig1
  | (_, _) -> overlap fig2 fig1;;

しっかしこれ、型推論無しでやったら大変そうだなぁ。型推論超便利！