;;; ;;; ;;; 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]))