;; file of common cmu functions which should be macros
;; I hope that by just loading in the file an environment will be
;; created which will permit the cmu files to be compiled.
(eval-when (compile eval load)
(or (boundp 'CMU-fcn-def) (setq CMU-fcn-def (getd 'def))))
; dv mark!changed *** list* [construct-list* lambda]
; neq push pop mukname (equivlance)
; prin1 (equiv to print) selectq lineread
;--- dv :: set variable to value and remember it was changed
; (dv name value) name is setq'ed to value (no evaluation) and
; the fact that it was done is remembered
(defmacro dv (name value)
(defmacro mark!changed (name)
(and (boundp '%changes) (setq %changes (cons atomname %changes)))
;--- *** :: comment macro
(defmacro *** (&rest x) nil)
;; this must be rewritten as a macro ****
;(def quote! (nlambda (a) (quote!-expr a)))
; this will be thrown away if the code below it works
(cons (eval (cadr x)) (quote!-expr (cddr x))))
(append (eval (cadr x)) (quote!-expr (cddr x))))
(setq u (quote!-expr (car x)))
(setq v (quote!-expr (cdr x)))
(cond ((and (eq u (car x)) (eq v (cdr x))) (return x)))
;; this is probably what the above forms do. (jkf)
(defmacro quote! (&rest a) (quote!-expr-mac a))
(eval-when (compile eval load)
(defun quote!-expr-mac (form)
`(cons ,(cadr form) ,(quote!-expr-mac (cddr form))))
(cond ((cddr form) `(append ,(cadr form)
,(quote!-expr-mac (cddr form))))
(t `(cons ,(quote!-expr-mac (car form))
,(quote!-expr-mac (cdr form))))))
;--- the following are macroizations from cmu3.l
(defmacro list* (&rest forms)
((null (cdr forms)) (car forms))
(t (construct-list* forms))))
(defun construct-list* (forms)
(setq forms (reverse forms))
(do ((forms (cddr forms) (cdr forms))
(return-form `(cons ,(cadr forms) ,(car forms))
`(cons ,(car forms) ,return-form)))
((null forms) return-form)))
(defmacro neq (a b) `(not (eq ,a ,b)))
(defmacro push (value stack) `(setq ,stack (cons ,value ,stack)))
(defmacro pop (stack &optional (storeit nil storeit-p))
(cond (storeit-p `(setq ,storeit (prog1 (car ,stack)
(setq ,stack (cdr ,stack)))))
(t `(prog1 (car ,stack) (setq ,stack (cdr ,stack))))))
;(jkf) this is actually maknum is the maclisp terminology
(putd 'munknam (getd 'maknum))
; added for CMULisp compatibilty (used by editor etc)
(putd 'prin1 (getd 'print))
;--- selectq :: case statement type construct
; <form> is evaluated and then compared with the tagi, if it matches
; the expri are evaluated. If it doesn't match, then <exprfinal> are
(defmacro lineread (&optional (x nil))
(defmacro de (name &rest body)
(cond ((status feature complr) `(def ,name (lambda ,@body)))
(t `(progn (putd ,name '(lambda ,@body))
(mark!changed ',name)))))
(defmacro dn (name &rest body)
(cond ((status feature complr) `(def ,name (nlambda ,@body)))
(t `(progn (putd ,name '(nlambda ,@body))
(mark!changed ',name)))))
(defmacro dm (name &rest body)
(cond ((status feature complr) `(def ,name (macro ,@body)))
(t `(progn (putd ,name '(macro ,@body))
(mark!changed ',name)))))
(eval-when (compile eval load)
(or (boundp 'OLD-fcn-def) (setq OLD-fcn-def (getd 'def))))
(defmacro def (&rest form)
(cond ((status feature complr)
(eval-when (compile) (putd 'def OLD-fcn-def))
(eval-when (compile) (putd 'def CMU-fcn-def))))
(t `(progn (putd ',(car form) ',(cadr form))
(mark!changed ',(car form))))))
(eval-when (compile eval load)
(or (boundp 'CMU-fcn-def) (setq CMU-fcn-def (getd 'def))))
(def Cdo (macro (l) (expand-do l)))
(def exists (macro (l) (expand-ex 'some l)))
(eval-when (compile eval load)
(cond ((atom (cadr form)) (ncons (cadr form)))
(car (setq form (cdddr form)))))
(cond ((cdr form) (list 'function (cadr form)))))))
(prog (label var init incr limit part)
((setq part (memq 'for l))
(setq l (append (ldiff l part) (cddr part)))))
((setq part (exists w l (memq w '(gets = _ :=))))
(setq l (append (ldiff l part) (cddr part)))))
((setq part (exists w l (memq w '(step by))))
(setq l (append (ldiff l part) (cddr part)))))
((setq part (memq 'to l))
(setq l (append (ldiff l part) (cddr part)))))
(list 'setq var (cond (init) (t 1))))))
((not ! exp) (return nil)))))
(cond (! exp (return nil)))))
(setq ! var (+ ! var ! (cond (incr) (t 1)))))))
(quote! (cond ((> ! var ! limit) (return nil))))))
(cons (cond ((memq (cadr form)
(progn (setq vars (cadr form))
(cond ((atom vars) (setq vars (list vars))))
(ldiff (cddr form) body))))))))
(cond ((atom vars) (setq vars (list vars))))
(setq body (Cnth (cdr form) (length vars))))
(def for (macro (l) (expand-do l)))
(def for-each (macro (l) (expand-fe l)))
(def forall (macro (l) (expand-ex 'every l)))
(def set-of (macro (l) (expand-set-of l)))
(def ty (macro (f) (append '(exec cat) (cdr f))))
(def until (macro (l) (expand-do l)))
(def while (macro (l) (expand-do l)))
(putprop 'cmumacs t 'version)