git » jacl.git » commit 26f66ac

diff --git a/list-operators.lisp b/list-operators.lisp
old mode 100644
new mode 100755
index 65ee4b1..762c6a7
--- a/list-operators.lisp
+++ b/list-operators.lisp
@@ -1,22 +1,28 @@
-(defun file-forms (file)
-  (with-open-file
-   (stream file)
-   (let ((eof (gensym)))
-     (loop for x = (read stream nil eof nil)
-           while (not (eq x eof))
-           collect x))))
+#!/usr/bin/sbcl --script
 
-(defun gather-ops (forms &aux (ops ()))
-  (loop for form in forms
-        when (listp form)
-        when (and (listp form)
-                  (symbolp (car form))
-                  (not (keywordp (car form)))
-                  (find-symbol (symbol-name (car form)) :cl))
-        do (progn
-               (push (car form) ops)
-               (nconc ops (gather-ops (cdr form))))
-        ;; TODO filter by whether interned in :cl package
-        finally (return (sort (remove-duplicates ops) #'string< :key #'symbol-name))))
-  
-                    
+(defun cl-op-form? (form)
+  (and (listp form)
+       (symbolp (car form))
+       (not (keywordp (car form)))
+       (not (member (car form) lambda-list-keywords))
+       (find-symbol (symbol-name (car form)) :cl)))
+
+(defun gather-cl-ops (form)
+  (cond ((cl-op-form? form)
+        (cons (car form) (mapcan #'gather-cl-ops form)))
+        ((listp form)
+         (mapcan #'gather-cl-ops form))))
+
+(defun read-forms (stream)
+  (loop with eof = (gensym)
+        for form = (ignore-errors (read stream nil eof nil))
+        while (not (eq form eof))
+        nconc (gather-cl-ops form) into ops
+        finally (return (sort (remove-duplicates ops) #'string<))))
+
+(defvar *ignore* '(declare speed))
+
+(loop for op in (read-forms *standard-input*)
+      when (not (member op *ignore*))
+      do (format t "~A~%" op))
+