読者です 読者をやめる 読者になる 読者になる

定義内のシンボルの数を数える。

シンボルの数を数えるといっても、実際は葉の数をかぞえているだけ。
なんか、冗長な処理がある。途中で方針変えたからなぁ。。。
作っていて思ったが、作り方がおかしい。なんかトップダウンで作っているし。こういうものって、ボトムアップで作るんだよなぁ。

(define *total-symbols* (make-hash-table))

(define (add-total-symbols! total)
  (let1 t (if (hash-table-exists? *total-symbols* total)
	      (+ 1 (hash-table-get *total-symbols* total))
	      1)
    (hash-table-put! *total-symbols* total (+ t 1))))
(define (show-result)
  (let1 keys (sort (hash-table-keys *total-symbols*) <)
    (for-each (lambda (key)
		(let1 value (hash-table-get *total-symbols* key)
		  (display #`"total symbol ,key : ,value")
		  (newline)))
	      keys)))


(define (count-definition-symbols s-exp)
  (if (pair? s-exp)
      (case (car s-exp)
	((define define-class define-condition-type define-constant 
	   define-generic define-in-module define-macro define-method
	   define-module define-reader-ctor define-record-type
	   define-syntax define-values)
	 (let ((name (car s-exp))
	       (total (count-symbols (cdr s-exp))))
	   (add-total-symbols! (car total))
	   total))
	(else
	 (count-symbols s-exp)))
      (count-symbols s-exp)))

(define (count-symbols s-exp)
  ;; list of list
  (define (filter-inners inners)
    (let loop ((inners inners)
	       (symbols 0)
	       (others '()))
      (cond ((null? inners) (values symbols others))
	    (else 
	     (if (number? (caar inners))
		 (loop (cdr inners)
		       (+ (caar inners) symbols)
		       others)
		 (loop (cdr inners)
		       symbols
		       (cons (car inners) others)))))))
  (let loop ((s-exp s-exp)
	     (symbols 0)
	     (inners '()))
    (cond ((null? s-exp)
	   (receive (syms defs)
	       (filter-inners inners)
	     (cons (+ symbols syms) defs))
	     )
	  ((not (pair? s-exp)) (loop '() (+ 1 symbols) inners))
	  ((pair? (car s-exp))
	   (loop (cdr s-exp)
		 symbols
		 (cons (count-definition-symbols (car s-exp))
		       inners)))
	  (else
	   (loop (cdr s-exp) (+ 1 symbols) inners)))))

(define (main args) ;entry point
  (let ((files (cdr args)))
    (for-each
     (cut call-with-input-file <>
	  (lambda (in)
	    (let loop ((s-exp (read in)))
	      (cond ((eof-object? s-exp) )
		    (else (count-definition-symbols s-exp)
			  (loop (read in)))))))
     files))
  (show-result))

totalとか、リストだったり数値だったり。絶対通らない条件とかありそう。