#!/usr/bin/chicken-scheme
;; AUTOCOMPILE: -O3

(module fg (plus)
  (import scheme
          fast-generic)

  (define-type <list> list?)
  (define-type <string> string?)
  (define-type <number> number?)

  (define-generic (plus (<list> l1) (<list> l2))
    (append l1 l2))

  (define-generic (plus (<string> s1) (<string> s2))
    (string-append s1 s2))

  (define-generic (plus (<number> n1) (<number> n2))
    (+ n1 n2)))

(module cg (plus)
  (import scheme
          chibi-generic)
  (define-generic plus)

  (define-method (plus (l1 list?) (l2 list?))
    (append l1 l2))

  (define-method (plus (s1 string?) (s2 string?))
    (string-append s1 s2))

  (define-method (plus (n1 number?) (n2 number?))
    (+ n1 n2)))

(module cp (plus)
  (import scheme
          coops
          coops-primitive-objects)

  (define-generic (plus arg1 arg2))
  (define-method (plus (l1 <list>) (l2 <list>))
    (append l1 l2))

  (define-method (plus (s1 <string>) (s2 <string>))
    (string-append s1 s2))

  (define-method (plus (n1 <number>) (n2 <number>))
    (+ n1 n2)))

(module gs (plus)
  (import scheme
          (only chicken.base error)
          generic-functions)
  (define-generic (plus l1 l2)
    (error "No type match"))
  (define-method (plus (l1 list??) (l2 list??))
    (append l1 l2))

  (define-method (plus (s1 string??) (s2 string??))
    (string-append s1 s2))

  (define-method (plus (n1 number??) (n2 number??))
    (+ n1 n2)))

(module main ()
  (import scheme
          (only chicken.base print)
          (only chicken.time time)
          (only miscmacros dotimes)
          fast-generic
          (prefix fg fg:)
          (prefix cg cg:)
          (prefix cp cp:)
          (prefix gs gs:))

  (define-type <list> list?)
  (define-type <string> string?)
  (define-type <number> number?)

  (define-generic (fgf:plus (<list> l1) (<list> l2))
    (append l1 l2))

  (define-generic (fgf:plus (<string> s1) (<string> s2))
    (string-append s1 s2))

  (define-generic (fgf:plus (<number> n1) (<number> n2))
    (+ n1 n2))


  (define (plus a b)
    (cond ((and (list? a) (list? b))
           (append a b))
          ((and (string? a) (string? b))
           (string-append a b))
          ((and (number? a) (number? b))
           (+ a b))))

  (print "generics:")
  (print (gs:plus '(1 2 3) '(1 2 3)))
  (time
   (dotimes (i 10000000)
     (gs:plus '(1 2 3) '(1 2 3))))

  (newline)
  (print "coops:")
  (print (cp:plus '(1 2 3) '(1 2 3)))
  (time
   (dotimes (i 10000000)
     (cp:plus '(1 2 3) '(1 2 3))))

  (newline)
  (print "chibi-generic:")
  (print (cg:plus '(1 2 3) '(1 2 3)))
  (time
   (dotimes (i 10000000)
     (cg:plus '(1 2 3) '(1 2 3))))

  (newline)
  (print "fast-generic:")
  (print (fg:plus '(1 2 3) '(1 2 3)))
  (time
   (dotimes (i 10000000)
     (fg:plus '(1 2 3) '(1 2 3))))

  (newline)
  (print "fast-generic (specialization):")
  (print (fgf:plus '(1 2 3) '(1 2 3)))
  (time
   (dotimes (i 10000000)
     (fgf:plus '(1 2 3) '(1 2 3))))

  (newline)
  (print "cond with predicates")
  (print (plus '(1 2 3) '(1 2 3)))
  (time
   (dotimes (i 10000000)
     (plus '(1 2 3) '(1 2 3)))))

;;; Output:

;; generics:
;; (1 2 3 1 2 3)
;; 89.741s CPU time, 1.857s GC time (major), 840000000/519922721 mutations (total/tracked), 3288/992337 GCs (major/minor), maximum live heap: 344.21 KiB

;; coops:
;; (1 2 3 1 2 3)
;; 14.812s CPU time, 0.215s GC time (major), 379/214388 GCs (major/minor), maximum live heap: 343.95 KiB

;; chibi-generic:
;; (1 2 3 1 2 3)
;; 3.194s CPU time, 0.02s GC time (major), 38/37825 GCs (major/minor), maximum live heap: 343.75 KiB

;; fast-generic:
;; (1 2 3 1 2 3)
;; 1.231s CPU time, 0.013s GC time (major), 10000000/12598 mutations (total/tracked), 26/22719 GCs (major/minor), maximum live heap: 343.87 KiB

;; fast-generic (specialization):
;; (1 2 3 1 2 3)
;; 0.875s CPU time, 0.01s GC time (major), 10000000/8002 mutations (total/tracked), 19/14176 GCs (major/minor), maximum live heap: 343.75 KiB

;; cond with predicates
;; (1 2 3 1 2 3)
;; 0.895s CPU time, 0.006s GC time (major), 11/16016 GCs (major/minor), maximum live heap: 343.77 KiB