;slamacs.cl
;some abbreviations and macros that slaconfg.cl preprocesses away
;(c) Dorai Sitaram, Dec. 1991, Rice U.

;basic rnrs abbrevs

; read #t and #f as t and nil resply

(set-dispatch-macro-character #\# #\t
  #'(lambda (ign1 ign2 ign3) t))

(set-dispatch-macro-character #\# #\f
  #'(lambda (ign1 ign2 ign3) nil))

(do ((s '(
	  angle phase
	  assoc scm/assoc
	  cl/assoc assoc
	  assv assoc
	  begin progn
	  char? characterp
	  char=? char=
	  char<? char<
	  char>? char>
	  char<=? char<=
	  char>=? char>=
	  char->integer char-int          
	  char-alphabetic? alpha-char-p
	  char-ci=? char-equal
	  char-ci<? char-lessp
	  char-ci>? char-greaterp
	  char-ci<=? char-not-greaterp
	  char-ci>=? char-not-lessp
	  char-numeric? digit-char-p
	  char-lower-case? lower-case-p
	  char-upper-case? upper-case-p
	  close-input-port close
	  close-output-port close
	  complex? complexp
	  display princ
	  else t
	  eq? eq
	  equal? equal
	  eqv? eql
	  even? evenp
	  for-each mapc
	  imag-part imagpart
	  input-port? streamp ;*put-stream-p expect stream arg
	  integer? integerp
	  integer->char int-char
	  list-ref elt
	  list-tail subseq
	  magnitude abs
	  make-rectangular complex
	  make-string scm/make-string
	  cl/make-string make-string
	  map mapcar
	  member scm/member
	  cl/member member
	  memv member
	  modulo mod
	  negative? minusp
	  newline terpri
	  null? null
	  number? numberp
	  odd? oddp
	  output-port? streamp
	  pair? consp
	  peek-char scm/peek-char
	  cl/peek-char peek-char
	  positive? plusp
	  rational? rationalp
	  read scm/read
	  cl/read read
	  read-char scm/read-char
	  cl/read-char read-char
	  real? floatp
	  real-part realpart
	  remainder rem
	  set! setq
	  set-car! rplaca
	  set-cdr! rplacd
	  string scm/string
	  cl/string string
	  string=? string=
	  string<? string<
	  string>? string>
	  string<=? string<=
	  string>=? string>=
	  string? stringp
	  string->symbol intern
	  symbol->string symbol-name
	  string-ci=? string-equal
	  string-ci<? string-lessp
	  string-ci>? string-greaterp
	  string-ci<=? string-not-greaterp
	  string-ci>=? string-not-lessp
	  string-length length
	  string-ref char
	  substring subseq
	  transcript-on dribble
	  transcript-off dribble
	  vector? vectorp
	  vector-length length
	  vector-ref elt
	  write prin1
	  zero? zerop
	  )
	(cddr s)))
    ((null s))
    (setf (get 'scm/clash-symbols (car s)) (cadr s)))

;additional abbrevs, for SLaTeX

(scm/defmacro defenum (&rest z)
  (do ((z z (cdr z))
       (n 0 (+ n 1))
       (r '() (cons `(define ,(car z) (int-char ,n)) r)))
      ((null z) `(progn ,@r))))

(scm/defmacro defrecord (name &rest fields)
  (do ((fields fields (cdr fields))
       (i 0 (+ i 1))
       (r '() (cons `(defvar ,(car fields) ,i) r)))
      ((null fields)
       `(progn
	  (define ,name (scm/lambda () (make-vector ,i)))
	  ,@r))))

(scm/defmacro of (r i &rest z)
  (cond ((null z) `(elt ,r ,i))
	((and (eq i '/) (= (length z) 1))
	 `(char ,r ,(car z)))
	(t `(of (elt ,r ,i) ,@z))))

(scm/defmacro extract-if (dialects &rest body)
  (if (member 'cl dialects)
      (if (= (length body) 1) (car body)
	`(progn ,@body))))

(scm/defmacro extract-if-not (dialects &rest body)
  (if (not (member 'cl dialects))
      (if (= (length body) 1) (car body)
	`(progn ,@body))))