Welcome to the CHICKEN Scheme pasting service

(use extras)
(use srfi-13)
(use srfi-1)

(import chicken scheme)

(load "~/hackery/scheme-random/display-all.scm")

;; Takes a string pattern and produces a list.
;; "a(bc)(de)f" => (a (b c) (d e) f)
(define (pattern->list pat)
  (letrec ((aux
	    (lambda (pat)
	      (cond ((null? pat) '())
		    ((char=? #\( (car pat))
		     (append (list (take-while (lambda (x)
						 (not (char=? x #\))))
					       (cdr pat)))
			     (aux (cdr (drop-while (lambda (x)
						     (not (char=? x #\))))
						   pat)))))
		    (else
		     (cons (car pat)
			   (aux (cdr pat))))))))
    (aux (string->list pat))))

(define (id x) x)
(define (match? word pat)
  (cond ((and (null? word) (null? pat))
	 ;; An empty pattern matches an empty WORD, and is our base-case.
	 #t)
	((or (and (null? word) (not (null? pat)))
	     (and (null? pat) (not (null? word))))
	 ;; Can't possibly be a (complete) match if one list is longer
	 ;; than the other. This is just a sanity-check as parsing the
	 ;; input should (or should it?) verify the lengths.
	 #f)
	((list? (car pat))
	 ;; Matching a list of possible values against car of WORD.
	 ;; Only one needs to match. If any of the list from MAP is #t,
	 ;; continue matching, otherwise, #f.
	 (if (any id (map (lambda (x) (char=? (car word) x)) (car pat)))
	     (match? (cdr word) (cdr pat))
	     #f))
	(else
	 ;; We have just a char to match against WORD.
	 (if (char=? (car word) (car pat))
	     (match? (cdr word) (cdr pat))
	     #f))))

(with-output-to-file "out.txt"
  (lambda ()
    (let* ((file (open-input-file "~/Downloads/A-large-practice.in"))
	   (tokens (string-tokenize (read-line file)))
	   (L (string->number (car tokens)))
	   (D (string->number (cadr tokens)))
	   (N (string->number (caddr tokens)))
	   (known (map string->list (read-lines file D))))
      (let lewp ((i 1)
		 (pat (pattern->list (read-line file))))
	(display-all "Case #" i ": "
		     (length (filter id (map (lambda (x) (match? x pat))
					     known))))
	(newline)
	(if (< i N)
	    (lewp (+ i 1)
		  (pattern->list (read-line file))))))))