; After Hull's PC-Scheme MiniManual for Appleby's book
; This file adds two new features
;    (macro  template expansion)
;    (define template expansion)
;  The templates are of form (name arg1 arg2 ...)
;                       or   name  
;                                \(short for (name))
; Iff the expansion starts with EVAL then it is evaluated before the
; template is bound to the result.
; Added Jan 93
;    (define name (LAMBDA (args) expr))
; Kludge - no good for multiargument functions
;    (define myname function_name)

(defmacro macro (template expr) 
	`(defmacro ,(car template) ,(cdr template) ,expr)
)
(macro (define template expr) 
       (prog (name  args e)
	(cond
  	    ((and (not (atom expr)) (eq (car expr) 'EVAL))
		(setq e (eval (cadr expr)))
	    )
	    ( T (setq e expr) )
	 )
	 (cond	((atom template)
		    (cond
		      ((atom e)
			(setq name template)
			(setq args '(X))
			(setq e (list e 'X))
		        (defunv name args e)
                      )
                      ((eq (car e) 'LAMBDA)
		        (setq name template)
		        (setq args (cadr e))
		        (setq e    (caddr e))
		        (defunv name args e)
                      )
                      ( T
			    (setq name template)
			    (setq args NIL)
			    (defunv name nil  e)
                      )
                   )
		)
	 	(T (setq name (car template)) 
		   (setq args (cdr template))
		   (defunv name args e)
		)
	 )
	 (princ name)(princ " ")(print  'defined)
	 (setf (symbol-value name) (list 'lambda args e) )
	 (return name)
	)
)
(macro (definition name) `(symbol-value ',name))