(use util.match)

;; examples from stklos.stk
;; TODO add match, match-let &c to gauche-mode.el?
;; (match 1) one special subform, yields:
;; (match foo
;;   ((...) ...))

(for-each
 (lambda (structure)
   (match structure
     ((a b c)
      (format #t "list, three elements: ~s, ~s, ~s\n" a b c))
     (('foo arg)
      (format #t "list, foo arg: ~s\n" arg))
     ((0 0)
      (format #t "list, two zeroes\n"))
     ((_ _)
      (format #t "list, any two elements: ~s\n" structure))
     ((_)
      (format #t "list: ~s\n" structure))
     (_
      (format #t "anything: ~s\n" structure))))
 '((1 2 3)
   (foo 42)
   (a a)
   (0 0)
   (0 0 0)
   ((a a) a)
   (a (a a))
   (a (a a) (a a a))
   1 foo #t ()
   (hopsa)))

;; gauche-mode tests
(define (foo)
  (match s
    (clause lalala)))

(define matcher
  (match-lambda
    ((_) 'list-of-one)
    ((_ _) 'list-of-two)
    (_ 'something-else)))

(print (map matcher '((a) (a a) (a a a))))

(match-let (((a b c) '(1 2 3))
            (('tag tagged) '(tag 'foo))
            ((x ...) '(a b c)))
  (print (list a b c)
         (list tagged)
         (list x)))

(match-let1 ('tag aap noot) '(tag 42 hopsa)
  (print (list aap noot)))

(match-define ('tag aap noot) '(tag 42 hopsa))

(print (list aap noot))

;; -----------------------------------------------------------------
;; haskell function definition tests

;; ack 0 n         = n+1
;; ack (m+1) 0     = ack m 1
;; ack (m+1) (n+1) = ack m (ack (m+1) n)
(define (ackermann m n)
  (match (list m n)
    ((0 q) (+ q 1))
    ((p 0) (ackermann (- p 1) 1))
    ((p q) (ackermann (- p 1) (ackermann p (- q 1))))))

(define (fibonacci n)
  (match n
    (0 0)
    (1 1)
    (n (+ (fibonacci (- n 1))
          (fibonacci (- n 2))))))

(define (gmap f s)
  (match s
    (() ())
    ((x . xs)
     (format #t "(:x ~s :xs ~s)\n" x xs)
     (cons (f x) (gmap f xs)))))

(print "(ackermann 3 3): " (ackermann 3 3))  ; 61
(print "(fibonacci 10): " (fibonacci 10))    ; 55
(print "gmap: " (gmap (lambda (x) (* x x)) '(1 2 3 4 5)))


;; -- insertion sort
;; insert                  :: Ord a => a -> [a] -> [a]
;; insert e []             = [e]
;; insert e (x:xs)
;;         | e<=x          = e : x : xs
;;         | otherwise     = x : insert e xs
;;
;; isort                   :: Ord a => [a] -> [a]
;; isort xs                = foldr insert [] xs

;; -- merge sort
;; merge                   :: Ord a => [a] -> [a] -> [a]
;; merge []     ys         = ys
;; merge xs     []         = xs
;; merge (x:xs) (y:ys)
;;         | x<=y          = x : merge xs (y:ys)
;;         | otherwise     = y : merge (x:xs) ys
;;
;; msort                   :: Ord a => [a] -> [a]
;; msort xs
;;         | len<=1        = xs
;;         | otherwise     = merge (msort ys) (msort zs)
;;         where ys        = take half xs
;;               zs        = drop half xs
;;               half      = div len 2
;;               len       = length xs
;;
;; -- quick sort
;; qsort                   :: Ord a => [a] -> [a]
;; qsort []                = []
;; qsort (x:xs)            = qsort [y | y <- xs, y <= x] ++
;;                           [x] ++
;;                           qsort [y | y <- xs, y > x]