(defun show-and-tell-type (symbol)
  (format t "~%~S IS A ~A" symbol
	  (cond ((get symbol 'si:type-predicate)
		 'SPECIFIER)
		((fboundp symbol)
		 (selectq (type-of (fsymeval symbol))
		   (cons 'MACRO)
		   (compiled-function 'FUNCTION)
		   (closure 'SPECIAL-FORM)))
		((get symbol 'system:system-constant)
		 'CONSTANT)
		((assq symbol si:*interpreter-declaration-type-alist*)
		 'DECLARATION)
		(t 'VARIABLE))))


(defun tester ()
  (progn
    (dolist (each '(unwind-protect	;things that are fboundp: macros, functions, and special forms
		       make-package  	
		     defvar))		
      (show-and-tell-type each))
    (dolist (each '(*package*	        ;things that are boundp: constants and variables
		     boole-and
		     ))		
      (show-and-tell-type each))
    (dolist (each '(short-float		;specifiers and declarations (elements of si:*standard-system-type-specifiers*)
		    notinline))
      (show-and-tell-type each))))


(defun parse-pair (infile outfile)
  (do ((item (read infile nil) (read infile nil))
       (route (read infile nil) (read infile nil)))
      ((null route) '*done*)
      (print item outfile)
    (if (fixnump (print (first route)))
      (prin1-then-space (cons
			  (cond ((get item 'si:type-predicate) 'ts)	;type specifier
				((fboundp item)
				 (selectq (type-of (fsymeval item))
				   (cons 'dm)		;defined macro
				   ((symbol compiled-function microcode-function) 'df)	;defined function
				   (closure 'sf)))		;special form
				((get item 'system:system-constant)
				 'sc)			;system constant
				((assq item si:*interpreter-declaration-type-alist*)
				 'ds)			;declaration specifier
				(t 'gv))			;global variable
			  route)
			outfile)
      (prin1-then-space route outfile))))



(setq *myfile* "gl:valid.valid-code;newbase.text")
(setq *yourfile* "gl:valid.valid-code;output-newbase.text")

(defun do-it (&optional (*infile* *myfile*) (*outfile* *yourfile*))
  (with-open-file (infile *infile* :direction ':input)
    (with-open-file (outfile *outfile* :direction ':output)
      (when (eq (parse-pair infile outfile) '*done*)
	   (return '*done*))))))