obarray)
res))
+(defun comp--compute-typeof-types ()
+ (append comp--typeof-builtin-types
+ (mapcar #'comp--cl-class-hierarchy (comp--all-classes))))
+
+(defun comp--compute--pred-type-h ()
+ (cl-loop with h = (make-hash-table :test #'eq)
+ for class-name in (comp--all-classes)
+ for pred = (get class-name 'cl-deftype-satisfies)
+ when pred
+ do (puthash pred class-name h)
+ finally return h))
+
(cl-defstruct comp-cstr-ctxt
- (typeof-types (append comp--typeof-builtin-types
- (mapcar #'comp--cl-class-hierarchy (comp--all-classes)))
+ (typeof-types (comp--compute-typeof-types)
:type list
:documentation "Type hierarchy.")
- (pred-type-h (cl-loop with h = (make-hash-table :test #'eq)
- for class-name in (comp--all-classes)
- for pred = (get class-name 'cl-deftype-satisfies)
- when pred
- do (puthash pred class-name h)
- finally return h)
+ (pred-type-h (comp--compute--pred-type-h)
:type hash-table
:documentation "Hash pred -> type.")
(union-typesets-mem (make-hash-table :test #'equal) :type hash-table
:documentation "Serve memoization for
`intersection-mem'."))
+(defun comp-cstr-ctxt-update-type-slots (ctxt)
+ "Update the type related slots of CTXT.
+This must run after byte compilation in order to account for user
+defined types."
+ (setf (comp-cstr-ctxt-typeof-types ctxt)
+ (comp--compute-typeof-types))
+ (setf (comp-cstr-ctxt-pred-type-h ctxt)
+ (comp--compute--pred-type-h)))
+
(defmacro with-comp-cstr-accessors (&rest body)
"Define some quick accessor to reduce code vergosity in BODY."
(declare (debug (form body))
"Byte-compile and spill the LAP representation for INPUT.
If INPUT is a symbol, it is the function-name to be compiled.
If INPUT is a string, it is the filename to be compiled."
- (let ((byte-native-compiling t)
- (byte-to-native-lambdas-h (make-hash-table :test #'eq))
- (byte-to-native-top-level-forms ())
- (byte-to-native-plist-environment ()))
- (comp-spill-lap-function input)))
+ (let* ((byte-native-compiling t)
+ (byte-to-native-lambdas-h (make-hash-table :test #'eq))
+ (byte-to-native-top-level-forms ())
+ (byte-to-native-plist-environment ())
+ (res (comp-spill-lap-function input)))
+ (comp-cstr-ctxt-update-type-slots comp-ctxt)
+ res))
\f
;;; Limplification pass specific code.