some tests for a lisp that compiles to OCaml

gistfile1.txt

(type (tree a b)
  Leaf
  (Node (a (list b)) (tree a b) (tree a b)))

(type (maybe a)
  Nothing
  (Just a))

(define empty Leaf)

(define (add k v)
  (function
    [Leaf (Node (k (list v)) Leaf Leaf)]
    [(Node (x y) left right)
     (if (x = k)
         (Node #(k (:: v y)) left right)
         (if (> k x)
             (Node (x y) left (add #(k v) right))
             (Node #(x y) (add #(k v) left) right)))]))

(define (find #(k v))
  (function
    [Leaf Nothing]
    [(Node #(x y) left right)
     (if (= x k)
         (match (List.mem v y)
           [(true) (Just y)]
           [(false) Nothing])
         (if (< x k)
             (find #(k v) left)
             (find #(k v) right)))]))

(define (find-paths k) ;; should I convert find-paths to find_paths ?
  (function
    [Leaf Nothing]
    [(Node #(x y) left right)
     (if (= x k)
         (Just y)
         (if (< x k)
             (find-paths k left)
             (find_paths k right)))]))

(type vertex int)
(type graphs #(vertex (list vertex)) tree)

(define (flip f)
  (fun (a b) (f b a)))

(define tree-from-list
  (List.fold_left (flip add) empty))

(define (reachable g v1 v2)
  (let1 iter (fun (current visited)
               (if (= current v2)
                   true
                   (match (find-paths current g)
                     [Nothing false]
                     [(Just '()) false]
                     [(Just x)
                      ;; we may need some macros like Clojure's -> and ->>
                      (List.fold_right (fun (p b) (|| b
                                                      (|| (= p v2)
                                                          (iter p (:: p visited)))))
                                       x
                                       false)])))
        (iter v1 '())))

;; all syntactic extensions should be made with macros
(let ((a 1)
      (b 2)
      (c 3))
  (+ a (+ b c)))

;; here's a simple let macro that nests let1's
;; I prefer CL-style non-hygienic macros
(defmacro let (defs &body body)
  (if (null defs)
    body
    (let ((d (car defs)))
      `(let1 ,(car d) ,(cadr d)
             (mylet ,(cdr defs) ,@body)))))

;; later let1's should be compiled to `let .. in`s of OCaml

target.ml

(*
 * After working with OCaml for a while, I realized that semantics are pretty
 * similar with Scheme's. It should be easy to create a Lisp that compiles to
 * OCaml.
 *
 * Lisp code is the source that I plan to compile this Ocaml:
 *)

type ('a, 'b) tree =
    Leaf
  | Node of ('a * ('b list)) * ('a, 'b) tree * ('a, 'b) tree

type 'a maybe = Nothing | Just of 'a

let empty = Leaf

let rec add (k, v) = function
    Leaf -> Node ((k, [v]), Leaf, Leaf)
  | Node ((x, y), left, right) ->
      if x = k then Node ((k, v :: y), left, right)
      else if k > x then Node ((x, y), left, (add (k, v) right))
      else Node ((x, y), (add (k, v) left), right)

let rec find (k, v) = function
    Leaf -> Nothing
  | Node ((x, y), left, right) ->
        if x = k then match List.mem v y with
                        true -> Just y
                      | false -> Nothing
        else if x < k then find (k, v) left
        else find (k, v) right

let rec find_paths k = function
    Leaf -> Nothing
  | Node ((x, y), left, right) ->
        if x = k then Just y
        else if x < k then find_paths k left
        else find_paths k right

type vertex = int
type graph = (vertex, vertex list) tree

let flip f = fun a b -> f b a
let tree_from_list = List.fold_left (flip add) empty

let vertices = tree_from_list [(1,2);(1,3);(1,4);(2,4);(3,4)]

let reachable g v1 v2 =
    let rec iter current visited =
        if current = v2 then true
        else match find_paths current g with
               Nothing -> false
             | Just [] -> false
             | Just x ->
                     List.fold_right
                         (fun p b -> b || p = v2 || iter p (p :: visited))
                         x
                         false
    in iter v1 []