;;; -*- Mode: COMMON-LISP; Fonts:(MEDFNT HL12B HL12I MEDFNB); Package: PASCALX; Base: 10 -*-

;1;;; MAINTENANCE NOTE:*
;1;; This file contains DEFMACROS and DEFCONSTANTS.  So it not only needs to be loaded during most compilations,*
;1;;  if it is modified, all uses of those macros and constants need to re recompiled.*


;1;; COMPILE-TIME CONSTANTS DEFINITIONS
3(DEFCONSTANT BIGGEST-CHARACTER**   #\ )
3(DEFCONSTANT SMALLEST-CHARACTER*  #\  )
3(DEFCONSTANT UNDEFINED-CHARACTER* #\NULL)
3(DEFCONSTANT MAXIMUM-INTEGER*     MOST-POSITIVE-FIXNUM)


;1;;; PRINT-IDENTIFIER CONSTANTS
3(DEFCONSTANT BUF-VARIABLE-OP**
	       (make-print-identifier :name '*file*-buffer-variable :package 'pascalx))
3(DEFCONSTANT CHAR-REF-OP*
	       (make-print-identifier :name '*char-ref* :package 'pascalx))
3(DEFCONSTANT COPY-OBJECT-OP*
	       (make-print-identifier :name '*copy-object* :package 'pascalx))
3(DEFCONSTANT COPYARRAY-OP*
	       (make-print-identifier :name '*copyarray* :package 'pascalx))
3(DEFCONSTANT DO-OP*
	       (make-print-identifier :name 'do))
3(DEFCONSTANT DOWNTO-OP*
	       (make-print-identifier :name 'downto))
3(DEFCONSTANT EVAL-BOTH-SIDES-OP*
	       (make-print-identifier :name '*evaluate-both-sides-of-booleans* :package 'pascalx))
3(DEFCONSTANT FILE-STREAM-OP*
	       (make-print-identifier :name '*file*-stream :package 'pascalx))
3(DEFCONSTANT FOR-OP*
	       (make-print-identifier :name 'for))
3(DEFCONSTANT FROM-OP*
	       (make-print-identifier :name 'from))
3(DEFCONSTANT INIT-ARRAY-OP*
	       (make-print-identifier :name '*init-array* :package 'pascalx))
3(DEFCONSTANT INITIALLY-OP*
	       (make-print-identifier :name 'initially))
3(DEFCONSTANT LOOP-OP*
	       (make-print-identifier :name 'loop))
3(DEFCONSTANT ORD-OP*
	       (make-print-identifier :name 'ord :package 'pascalx))
3(DEFCONSTANT POINTER-OP*
	       (make-print-identifier :name '*pointer* :package 'pascalx))
3(DEFCONSTANT PRED-OP*
	       (make-print-identifier :name 'pred :package 'pascalx))
B(DEFCONSTANT PREDECESSOR-OP*
	       (make-print-identifier :name '*predecessor* :package 'pascalx))
3(DEFCONSTANT SET-FOR-SETS-OP*
	       (make-print-identifier :name '*set-for-sets* :package 'pascalx))
3(DEFCONSTANT SET-OP*
	       (make-print-identifier :name '*set* :package 'pascalx))
3(DEFCONSTANT SET-UP-FILE-VARIABLE-OP*
	       (make-print-identifier :name '*set-up-file-variable* :package 'pascalx))
3(DEFCONSTANT SIGNAL-RUNTIME-ERROR-OP*
	       (make-print-identifier :name '*signal-runtime-error* :package 'pascalx))
3(DEFCONSTANT SUCC-OP*
	       (make-print-identifier :name 'succ :package 'pascalx))
3(DEFCONSTANT SUCCESSOR-OP*
	       (make-print-identifier :name '*successor* :package 'pascalx))
3(DEFCONSTANT TO-OP*
	       (make-print-identifier :name 'to))
3(DEFCONSTANT VAR-PARM-REF-OP*
	       (make-print-identifier :name '*var-parm-ref* :package 'pascalx))
3(DEFCONSTANT WHILE-OP*
	       (make-print-identifier :name 'while))


;1;;; GLOBAL MACRO Definitions
3(DEFMACRO WHEN-TYPE-CHECKING (&body body)**
  2"Executes BODY only if *TYPE-CHECKING-P* is true."*
   `(when *TYPE-CHECKING-P* ,@body))

3(DEFMACRO PARSER-ERROR-HANDLER (string fun &optional (token nil))*
   (declare (function parser-error-handler (string symbol (or null counter token)) nil))
   `(let ((start  (etypecase ,token
		    (number  ,token)
		    (null    nil)
		    (token   (1- (token-start ,token)))))
	 (line-no (when (and (not (null ,token))
			     (not (numberp ,token)))
		    (token-line-no ,token))))
     (error-handler ,fun (format nil
				"~@[~A~%~]
                                 ~@[         ~V,,,' <~>~%~]~
                                 ~A~@[ on line number ~A~]"
				(not *LOG-STREAM*) start ,string line-no)))
   );1parser-error-handler

3(DEFMACRO RECORD-ACCESSOR (symtab-record-type field-name)*
   2"Return the record accessor of a field. NOTE: there is no checking* 2done to see if indeed this is a field"**
  `(make-print-identifier
     :name (intern (concatenate 'string (field-accessor-prefix ,symtab-record-type) ,field-name))
     :package *output-package*))