assoc.egi

;;;;;
;;;;;
;;;;; Assoc-Collection
;;;;;
;;;;;

(define $to-assoc
  (lambda [$xs]
    (match xs (list something)
      {[<nil> {}]
       [<cons $x (loop $i [2 $n]
                   <cons ,x ...>
                   (& !<cons ,x _> $rs))>
        {[x n] @(to-assoc rs)}]})))

(define $from-assoc
  (lambda [$xs]
    (match xs (list [something integer])
      {[<nil> {}]
       [<cons [$x $n] $rs>
        {@(take n (repeat1 x)) @(from-assoc rs)}]})))

;;;
;;; Assoc List
;;;

(define $assoc-list
  (lambda [$a]
    (matcher
      {[<nil> []
        {[{} {[]}]
         [_ {}]}]
       [<cons $ $> [a (assoc-list a)]
        {[$tgt (match tgt (list [something integer])
                 {[<cons [$x ,1] $rs> {[x rs]}]
                  [<cons [$x $n] $rs> {[x {[x (- n 1)] @rs}]}]
                  [_ {}]})]}]
       [<ncons $ ,$k $> [a (assoc-list a)]
        {[$tgt (match tgt (list [something integer])
                 {[<cons [$x ,k] $rs> {[x rs]}]
                  [<cons [$x (& ?(gt? $ k) $n)] $rs> {[x {[x (- n k)] @rs}]}]
                  [_ {}]})]}]
       [<ncons $ $ $> [a integer (assoc-list a)]
        {[$tgt (match tgt (list [something integer])
                 {[<cons [$x $k] $rs> {[x k rs]}]
                  [_ {}]})]}]
       [,$val []
        {[$tgt (if (eq? val tgt) {[]} {})]}]
       [$ [something]
        {[$tgt {tgt}]}]
       })))

;;;
;;; Assoc Multiset
;;;

(define $assoc-multiset
  (lambda [$a]
    (matcher
      {[<nil> []
        {[{} {[]}]
         [_ {}]}]
       [<cons ,$x $> [(assoc-multiset a)]
        {[$tgt (match-all tgt (list [a integer])
                 [<join $hs <cons [,x $n] $ts>>
                  (if (eq? n 1)
                    {@hs @ts}
                    {@hs [x (- n 1)] @ts})])]}]
       [<cons $ $> [a (assoc-multiset a)]
        {[$tgt (match-all tgt (list [a integer])
                 [<join $hs <cons [$x $n] $ts>>
                  (if (eq? n 1)
                    [x {@hs @ts}]
                    [x {@hs [x (- n 1)] @ts}])])]}]
       [<ncons ,$x ,$n $> [(assoc-multiset a)]
        {[$tgt (match-all tgt (list [a integer])
                 [<join $hs <cons [,x (& ?(gte? $ n) $k)] $ts>>
                  (if (eq? (- k n) 0)
                    {@hs @ts}
                    {@hs [x (- k n)] @ts})])]}]
       [<ncons $ ,$n $> [a (assoc-multiset a)]
        {[$tgt (match-all tgt (list [a integer])
                 [<join $hs <cons [$x (& ?(gte? $ n) $k)] $ts>>
                  (if (eq? (- k n) 0)
                    [x {@hs @ts}]
                    [x {@hs [x (- k n)] @ts}])])]}]
       [<ncons ,$x $ $> [integer (assoc-multiset a)]
        {[$tgt (match-all tgt (list [a integer])
                 [<join $hs <cons [,x $n] $ts>>
                  [n {@hs @ts}]])]}]
       [<ncons $ $ $> [a integer (assoc-multiset a)]
        {[$tgt (match-all tgt (list [a integer])
                 [<join $hs <cons [$x $n] $ts>>
                  [x n {@hs @ts}]])]}]
       [$ [something]
        {[$tgt {tgt}]}]
       })))

(define $AC.intersect
  (lambda [$xs $ys]
    (match-all [xs ys] [(assoc-multiset something) (assoc-multiset something)]
      [[<ncons $x $m _> <ncons ,x $n _>] [x (min {m n})]])))

(define $AC.intersect/m
  (lambda [$a $xs $ys]
    (match-all [xs ys] [(assoc-multiset a) (assoc-multiset a)]
      [[<ncons $x $m _> <ncons ,x $n _>] [x (min {m n})]])))