競プロデッキ in Scheme

task.scm

(use gauche.lazy)
(use gauche.collection)
(use util.match)
(use math.prime)

; bit
(define << ash)
(define & logand)
(define lor logior)
(define xor logxor)

; vector
(define mv make-vector)
(define vs! vector-set!)
(define-method object-apply ((vec <vector>) (i <integer>) :optional fallback)
  (vector-ref vec i fallback))

; hash-table
(define mt make-hash-table)
(define ts! hash-table-set!)
(define-method object-apply ((table <hash-table>) key :optional default)
  (hash-table-get table key default))

; lib
(define (inc x) (+ x 1))
(define (dec x) (- x 1))
(define (range s e)
  (let loop [(i s)]
    (if (>= i e)
      ()
      (cons i (loop (inc i))))))
(define (counter lst comp)
  (let ([table (mt comp)])
    (let loop ([l lst])
      (if (null? l)
        table
        (begin
          (hs! table (car l) (+ 1 (hash-table-get table (car l) 0)))
          (loop (cdr l)))))))
(define (memoize f)
  (let ([cache (make-hash-table equal-comparator)])
    (lambda x
      (or (hash-table-get cache x #f)
          (let ([result (apply f x)])
            (hash-table-put! cache x result)
            result)))))

; functional
; partinal: pa$ map$ filter$ any$ every$
; compose: .$

; lazy
; lmap lfilter

; lazy-partial
(define (lmap$ f) (pa$ lmap f))
(define (lfilter$ f) (pa$ lfilter f))

; prime
; (take *primes* n)
; naive-factorize, small-prime?(341,550,071,728,321まで)

; input
(define (my-read)
  (let ([a (read)])
    (if (symbol? a)
      (symbol->string a)
      a)))
(define (my-read-line)
  (let ([line (read-line)])
    (if (string=? "" line)
        (my-read-line)
        line)))

; input macro
(define-syntax solve
  (syntax-rules (: list vec grid)
    ((_ [var : list n])
     (define var
       (let loop ([i n])
         (if (zero? i)
           ()
           (cons (my-read) (loop (- i 1)))))))
    ((_ [var : vec n])
     (define var
       (let ([v (make-vector n)])
         (dotimes (i n)
           (vector-set! v i (my-read)))
         v)))
    ((_ [var : vec n m])
     (define var
       (let ([v (make-vector m)])
         (dotimes (i m)
           (solve [u : vec n])
           (vector-set! v i u))
         v)))
    ((_ [var : grid h])
     (define var
      (let ([v (make-vector h)])
       (dotimes (i h)
         (let ([row (list->vector (string->list (my-read-line)))])
          (vector-set! v i row)))
       v)))
    ((_ (expr ...))
     (expr ...))
    ((_ var)
     (define var
       (my-read)))
    ((_ expr1 expr2 ...)
     (begin
       (solve expr1)
       (solve expr2 ...)))))
; ---------------------------