;;;
;;;
;;; Tree demonstration
;;;
;;;

;;
;; Matcher definition
;;
(define $tree
  (lambda [$a $b]
    (matcher
      {[,$val []
        {[$tgt (match [val tgt] [(tree a b) (tree a b)]
                 {[[<lnode $x $ts> <lnode ,x ,ts>] {[]}]
                  [[_ _] {}]})]}]
       [<leaf $> b
        {[<Leaf $x> {x}]
         [_ {}]}]
       [<lnode $ $> [a (list (tree a b))] ; Node whose children are seen as a list.
        {[<Node $x $ts> {[x ts]}]
         [_ {}]}]
       [<mnode $ $> [a (multiset (tree a b))] ; Node whose children are seen as a multiset.
        {[<Node $x $ts> {[x ts]}]
         [_ {}]}]
       [<descendant $> [(tree a b)]
        {[$t (match-all t (tree a b)
               [(loop $i [1 _] <mnode _ <cons ... _>> $x) x])]}]
       [$ [something]
        {[$tgt {tgt}]}]
       })))

;;
;; Demonstration code
;;
(define $tree-data
  <Node "Programming language"
    {<Node "Pattern-matching oriented"
       {<Leaf "Egison">}>
     <Node "Functional language"
       {<Node "Strictly typed"
          {<Leaf "OCaml">
           <Leaf "Haskell">
           <Leaf "Curry">
           <Leaf "Coq">
           }>
        <Node "Dynamically typed"
          {<Leaf "Egison">
           <Leaf "Lisp">
           <Leaf "Scheme">
           <Leaf "Clojure">
           }>
        }>
     <Node "Logic programming"
       {<Leaf "Prolog">
        <Leaf "LiLFeS">
        <Leaf "Curry">
        }>
     <Node "Object oriented"
       {<Leaf "C++">
        <Leaf "Java">
        <Leaf "Ruby">
        <Leaf "Python">
        <Leaf "OCaml">
        }>
     }>)


; All langauges
(test (unique/m string (match-all tree-data (tree string string)
                         [<descendant <leaf $x>> x])))
        
; All langauges that belongs to Functional language
(test (unique/m string (match-all tree-data (tree string string)
                         [<descendant <mnode ,"Functional language" <cons <descendant <leaf $x>> _>>> x])))
        
; All langauges that belongs more than two categories
(test (unique/m string (match-all tree-data (tree string string)
                         [<mnode _ <cons <descendant <leaf $x>>
                                         <cons <descendant <leaf ,x>>
                                               _>>>
                          x])))

; All categories that Egison belongs
(test (match-all tree-data (tree string string)
        [(loop $i [1 $n]
               <mnode $c_i <cons ... _>>
               <leaf ,"Egison">)
         c]))