mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-11 09:20:51 +00:00
1198 lines
43 KiB
EmacsLisp
1198 lines
43 KiB
EmacsLisp
;;; comp-cstr.el --- native compiler constraint library -*- lexical-binding: t -*-
|
||
|
||
;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
|
||
|
||
;; Author: Andrea Corallo <akrl@sdf.com>
|
||
;; Keywords: lisp
|
||
;; Package: emacs
|
||
|
||
;; This file is part of GNU Emacs.
|
||
|
||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation, either version 3 of the License, or
|
||
;; (at your option) any later version.
|
||
|
||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||
|
||
;;; Commentary:
|
||
|
||
;; Constraint library in use by the native compiler.
|
||
|
||
;; In LIMPLE each non immediate value is represented by a `comp-mvar'.
|
||
;; The part concerning the set of all values the `comp-mvar' can
|
||
;; assume is described into its constraint `comp-cstr'. Each
|
||
;; constraint consists in a triplet: type-set, value-set, range-set.
|
||
;; This file provide set operations between constraints (union
|
||
;; intersection and negation) plus routines to convert from and to a
|
||
;; CL like type specifier.
|
||
|
||
;;; Code:
|
||
|
||
(require 'cl-lib)
|
||
|
||
(defconst comp--typeof-types (mapcar (lambda (x)
|
||
(append x '(t)))
|
||
cl--typeof-types)
|
||
;; TODO can we just add t in `cl--typeof-types'?
|
||
"Like `cl--typeof-types' but with t as common supertype.")
|
||
|
||
(defconst comp--all-builtin-types
|
||
(append cl--all-builtin-types '(t))
|
||
"Likewise like `cl--all-builtin-types' but with t as common supertype.")
|
||
|
||
(cl-defstruct (comp-cstr (:constructor comp-type-to-cstr
|
||
(type &aux
|
||
(null (eq type 'null))
|
||
(integer (eq type 'integer))
|
||
(typeset (if (or null integer)
|
||
nil
|
||
(list type)))
|
||
(valset (when null
|
||
'(nil)))
|
||
(range (when integer
|
||
'((- . +))))))
|
||
(:constructor comp-value-to-cstr
|
||
(value &aux
|
||
(integer (integerp value))
|
||
(valset (unless integer
|
||
(list value)))
|
||
(range (when integer
|
||
`((,value . ,value))))
|
||
(typeset ())))
|
||
(:constructor comp-irange-to-cstr
|
||
(irange &aux
|
||
(range (list irange))
|
||
(typeset ())))
|
||
(:copier comp-cstr-shallow-copy))
|
||
"Internal representation of a type/value constraint."
|
||
(typeset '(t) :type list
|
||
:documentation "List of possible types the mvar can assume.
|
||
Each element cannot be a subtype of any other element of this slot.")
|
||
(valset () :type list
|
||
:documentation "List of possible values the mvar can assume.
|
||
Integer values are handled in the `range' slot.")
|
||
(range () :type list
|
||
:documentation "Integer interval.")
|
||
(neg nil :type boolean
|
||
:documentation "Non-nil if the constraint is negated"))
|
||
|
||
(cl-defstruct comp-cstr-f
|
||
"Internal constraint representation for a function."
|
||
(args () :type list
|
||
:documentation "List of `comp-cstr' for its arguments.")
|
||
(ret nil :type (or comp-cstr comp-cstr-f)
|
||
:documentation "Returned value."))
|
||
|
||
(cl-defstruct comp-cstr-ctxt
|
||
(union-typesets-mem (make-hash-table :test #'equal) :type hash-table
|
||
:documentation "Serve memoization for
|
||
`comp-union-typesets'.")
|
||
;; TODO we should be able to just cons hash this.
|
||
(common-supertype-mem (make-hash-table :test #'equal) :type hash-table
|
||
:documentation "Serve memoization for
|
||
`comp-common-supertype'.")
|
||
(subtype-p-mem (make-hash-table :test #'equal) :type hash-table
|
||
:documentation "Serve memoization for
|
||
`comp-subtype-p-mem'.")
|
||
(union-1-mem-no-range (make-hash-table :test #'equal) :type hash-table
|
||
:documentation "Serve memoization for
|
||
`comp-cstr-union-1'.")
|
||
(union-1-mem-range (make-hash-table :test #'equal) :type hash-table
|
||
:documentation "Serve memoization for
|
||
`comp-cstr-union-1'.")
|
||
(intersection-mem (make-hash-table :test #'equal) :type hash-table
|
||
:documentation "Serve memoization for
|
||
`intersection-mem'."))
|
||
|
||
(defmacro with-comp-cstr-accessors (&rest body)
|
||
"Define some quick accessor to reduce code vergosity in BODY."
|
||
(declare (debug (form body))
|
||
(indent defun))
|
||
`(cl-macrolet ((typeset (x)
|
||
`(comp-cstr-typeset ,x))
|
||
(valset (x)
|
||
`(comp-cstr-valset ,x))
|
||
(range (x)
|
||
`(comp-cstr-range ,x))
|
||
(neg (x)
|
||
`(comp-cstr-neg ,x)))
|
||
,@body))
|
||
|
||
(defun comp-cstr-copy (cstr)
|
||
"Return a deep copy of CSTR."
|
||
(with-comp-cstr-accessors
|
||
(make-comp-cstr :typeset (copy-sequence (typeset cstr))
|
||
:valset (copy-sequence (valset cstr))
|
||
:range (copy-tree (range cstr))
|
||
:neg (neg cstr))))
|
||
|
||
(defsubst comp-cstr-empty-p (cstr)
|
||
"Return t if CSTR is equivalent to the `nil' type specifier or nil otherwise."
|
||
(with-comp-cstr-accessors
|
||
(and (null (typeset cstr))
|
||
(null (valset cstr))
|
||
(null (range cstr))
|
||
(null (neg cstr)))))
|
||
|
||
(defsubst comp-cstr-null-p (cstr)
|
||
"Return t if CSTR is equivalent to the `null' type specifier, nil otherwise."
|
||
(with-comp-cstr-accessors
|
||
(and (null (typeset cstr))
|
||
(null (range cstr))
|
||
(null (neg cstr))
|
||
(equal (valset cstr) '(nil)))))
|
||
|
||
(defun comp-cstrs-homogeneous (cstrs)
|
||
"Check if constraints CSTRS are all homogeneously negated or non-negated.
|
||
Return `pos' if they are all positive, `neg' if they are all
|
||
negated or nil othewise."
|
||
(cl-loop
|
||
for cstr in cstrs
|
||
unless (comp-cstr-neg cstr)
|
||
count t into n-pos
|
||
else
|
||
count t into n-neg
|
||
finally
|
||
(cond
|
||
((zerop n-neg) (cl-return 'pos))
|
||
((zerop n-pos) (cl-return 'neg)))))
|
||
|
||
(defun comp-split-pos-neg (cstrs)
|
||
"Split constraints CSTRS into non-negated and negated.
|
||
Return them as multiple value."
|
||
(cl-loop
|
||
for cstr in cstrs
|
||
if (comp-cstr-neg cstr)
|
||
collect cstr into negatives
|
||
else
|
||
collect cstr into positives
|
||
finally return (cl-values positives negatives)))
|
||
|
||
;; So we can load comp-cstr.el and comp.el in non native compiled
|
||
;; builds.
|
||
(defvar comp-ctxt nil)
|
||
|
||
(defvar comp-cstr-one (comp-value-to-cstr 1)
|
||
"Represent the integer immediate one.")
|
||
|
||
(defvar comp-cstr-t (comp-type-to-cstr t)
|
||
"Represent the superclass t.")
|
||
|
||
|
||
;;; Value handling.
|
||
|
||
(defun comp-normalize-valset (valset)
|
||
"Sort and remove duplicates from VALSET then return it."
|
||
(cl-sort (cl-remove-duplicates valset :test #'eq)
|
||
(lambda (x y)
|
||
(cond
|
||
((and (symbolp x) (symbolp y))
|
||
(string< x y))
|
||
((and (symbolp x) (not (symbolp y)))
|
||
t)
|
||
((and (not (symbolp x)) (symbolp y))
|
||
nil)
|
||
(t
|
||
(< (sxhash-equal x)
|
||
(sxhash-equal y)))))))
|
||
|
||
(defun comp-union-valsets (&rest valsets)
|
||
"Union values present into VALSETS."
|
||
(comp-normalize-valset (cl-reduce #'cl-union valsets)))
|
||
|
||
(defun comp-intersection-valsets (&rest valsets)
|
||
"Union values present into VALSETS."
|
||
(comp-normalize-valset (cl-reduce #'cl-intersection valsets)))
|
||
|
||
|
||
;;; Type handling.
|
||
|
||
(defun comp-normalize-typeset (typeset)
|
||
"Sort TYPESET and return it."
|
||
(cl-sort (cl-remove-duplicates typeset)
|
||
(lambda (x y)
|
||
(string-lessp (symbol-name x)
|
||
(symbol-name y)))))
|
||
|
||
(defun comp-supertypes (type)
|
||
"Return a list of pairs (supertype . hierarchy-level) for TYPE."
|
||
(cl-loop
|
||
named outer
|
||
with found = nil
|
||
for l in comp--typeof-types
|
||
do (cl-loop
|
||
for x in l
|
||
for i from (length l) downto 0
|
||
when (eq type x)
|
||
do (setf found t)
|
||
when found
|
||
collect `(,x . ,i) into res
|
||
finally (when found
|
||
(cl-return-from outer res)))))
|
||
|
||
(defun comp-common-supertype-2 (type1 type2)
|
||
"Return the first common supertype of TYPE1 TYPE2."
|
||
(when-let ((types (cl-intersection
|
||
(comp-supertypes type1)
|
||
(comp-supertypes type2)
|
||
:key #'car)))
|
||
(car (cl-reduce (lambda (x y)
|
||
(if (> (cdr x) (cdr y)) x y))
|
||
types))))
|
||
|
||
(defun comp-common-supertype (&rest types)
|
||
"Return the first common supertype of TYPES."
|
||
(or (gethash types (comp-cstr-ctxt-common-supertype-mem comp-ctxt))
|
||
(puthash types
|
||
(cl-reduce #'comp-common-supertype-2 types)
|
||
(comp-cstr-ctxt-common-supertype-mem comp-ctxt))))
|
||
|
||
(defsubst comp-subtype-p (type1 type2)
|
||
"Return t if TYPE1 is a subtype of TYPE2 or nil otherwise."
|
||
(let ((types (cons type1 type2)))
|
||
(or (gethash types (comp-cstr-ctxt-subtype-p-mem comp-ctxt))
|
||
(puthash types
|
||
(eq (comp-common-supertype-2 type1 type2) type2)
|
||
(comp-cstr-ctxt-subtype-p-mem comp-ctxt)))))
|
||
|
||
(defun comp-union-typesets (&rest typesets)
|
||
"Union types present into TYPESETS."
|
||
(or (gethash typesets (comp-cstr-ctxt-union-typesets-mem comp-ctxt))
|
||
(puthash typesets
|
||
(cl-loop
|
||
with types = (apply #'append typesets)
|
||
with res = '()
|
||
for lane in comp--typeof-types
|
||
do (cl-loop
|
||
with last = nil
|
||
for x in lane
|
||
when (memq x types)
|
||
do (setf last x)
|
||
finally (when last
|
||
(push last res)))
|
||
finally return (comp-normalize-typeset res))
|
||
(comp-cstr-ctxt-union-typesets-mem comp-ctxt))))
|
||
|
||
(defun comp-intersect-two-typesets (t1 t2)
|
||
"Intersect typesets T1 and T2."
|
||
(with-comp-cstr-accessors
|
||
(cl-loop
|
||
for types in (list t1 t2)
|
||
for other-types in (list t2 t1)
|
||
append
|
||
(cl-loop
|
||
for type in types
|
||
when (cl-some (lambda (x)
|
||
(comp-subtype-p type x))
|
||
other-types)
|
||
collect type))))
|
||
|
||
(defun comp-intersect-typesets (&rest typesets)
|
||
"Intersect types present into TYPESETS."
|
||
(unless (cl-some #'null typesets)
|
||
(if (length= typesets 1)
|
||
(car typesets)
|
||
(comp-normalize-typeset
|
||
(cl-reduce #'comp-intersect-two-typesets typesets)))))
|
||
|
||
|
||
;;; Integer range handling
|
||
|
||
(defsubst comp-star-or-num-p (x)
|
||
(or (numberp x) (eq '* x)))
|
||
|
||
(defsubst comp-range-1+ (x)
|
||
(if (symbolp x)
|
||
x
|
||
(1+ x)))
|
||
|
||
(defsubst comp-range-1- (x)
|
||
(if (symbolp x)
|
||
x
|
||
(1- x)))
|
||
|
||
(defsubst comp-range-+ (x y)
|
||
(pcase (cons x y)
|
||
((or '(+ . -) '(- . +)) '??)
|
||
((or `(- . ,_) `(,_ . -)) '-)
|
||
((or `(+ . ,_) `(,_ . +)) '+)
|
||
(_ (+ x y))))
|
||
|
||
(defsubst comp-range-- (x y)
|
||
(pcase (cons x y)
|
||
((or '(+ . +) '(- . -)) '??)
|
||
('(+ . -) '+)
|
||
('(- . +) '-)
|
||
((or `(+ . ,_) `(,_ . -)) '+)
|
||
((or `(- . ,_) `(,_ . +)) '-)
|
||
(_ (- x y))))
|
||
|
||
(defsubst comp-range-< (x y)
|
||
(cond
|
||
((eq x '+) nil)
|
||
((eq x '-) t)
|
||
((eq y '+) t)
|
||
((eq y '-) nil)
|
||
(t (< x y))))
|
||
|
||
(defsubst comp-cstr-smallest-in-range (range)
|
||
"Smallest entry in RANGE."
|
||
(caar range))
|
||
|
||
(defsubst comp-cstr-greatest-in-range (range)
|
||
"Greater entry in RANGE."
|
||
(cdar (last range)))
|
||
|
||
(defun comp-range-union (&rest ranges)
|
||
"Combine integer intervals RANGES by union set operation."
|
||
(cl-loop
|
||
with all-ranges = (apply #'append ranges)
|
||
with lows = (mapcar (lambda (x)
|
||
(cons (comp-range-1- (car x)) 'l))
|
||
all-ranges)
|
||
with highs = (mapcar (lambda (x)
|
||
(cons (cdr x) 'h))
|
||
all-ranges)
|
||
with nest = 0
|
||
with low = nil
|
||
with res = ()
|
||
for (i . x) in (cl-sort (nconc lows highs) #'comp-range-< :key #'car)
|
||
if (eq x 'l)
|
||
do
|
||
(when (zerop nest)
|
||
(setf low i))
|
||
(cl-incf nest)
|
||
else
|
||
do
|
||
(when (= nest 1)
|
||
(push `(,(comp-range-1+ low) . ,i) res))
|
||
(cl-decf nest)
|
||
finally return (reverse res)))
|
||
|
||
(defun comp-range-intersection (&rest ranges)
|
||
"Combine integer intervals RANGES by intersecting."
|
||
(cl-loop
|
||
with all-ranges = (apply #'append ranges)
|
||
with n-ranges = (length ranges)
|
||
with lows = (mapcar (lambda (x)
|
||
(cons (car x) 'l))
|
||
all-ranges)
|
||
with highs = (mapcar (lambda (x)
|
||
(cons (cdr x) 'h))
|
||
all-ranges)
|
||
with nest = 0
|
||
with low = nil
|
||
with res = ()
|
||
for (i . x) in (cl-sort (nconc lows highs) #'comp-range-< :key #'car)
|
||
initially (when (cl-some #'null ranges)
|
||
;; Intersecting with a null range always results in a
|
||
;; null range.
|
||
(cl-return '()))
|
||
if (eq x 'l)
|
||
do
|
||
(cl-incf nest)
|
||
(when (= nest n-ranges)
|
||
(setf low i))
|
||
else
|
||
do
|
||
(when (= nest n-ranges)
|
||
(push `(,low . ,i)
|
||
res))
|
||
(cl-decf nest)
|
||
finally return (reverse res)))
|
||
|
||
(defun comp-range-negation (range)
|
||
"Negate range RANGE."
|
||
(if (null range)
|
||
'((- . +))
|
||
(cl-loop
|
||
with res = ()
|
||
with last-h = '-
|
||
for (l . h) in range
|
||
unless (eq l '-)
|
||
do (push `(,(comp-range-1+ last-h) . ,(1- l)) res)
|
||
do (setf last-h h)
|
||
finally
|
||
(unless (eq '+ last-h)
|
||
(push `(,(1+ last-h) . +) res))
|
||
(cl-return (reverse res)))))
|
||
|
||
(defsubst comp-cstr-set-cmp-range (dst old-dst ext-range)
|
||
"Support range comparison functions."
|
||
(with-comp-cstr-accessors
|
||
(if ext-range
|
||
(setf (typeset dst) (when (cl-some (lambda (x)
|
||
(comp-subtype-p 'float x))
|
||
(typeset old-dst))
|
||
'(float))
|
||
(valset dst) ()
|
||
(range dst) (if (range old-dst)
|
||
(comp-range-intersection (range old-dst)
|
||
ext-range)
|
||
ext-range)
|
||
(neg dst) nil)
|
||
(setf (typeset dst) (typeset old-dst)
|
||
(valset dst) (valset old-dst)
|
||
(range dst) (range old-dst)
|
||
(neg dst) (neg old-dst)))))
|
||
|
||
(defmacro comp-cstr-set-range-for-arithm (dst src1 src2 &rest range-body)
|
||
;; Prevent some code duplication for `comp-cstr-add-2'
|
||
;; `comp-cstr-sub-2'.
|
||
(declare (debug (range-body))
|
||
(indent defun))
|
||
`(with-comp-cstr-accessors
|
||
(when-let ((r1 (range ,src1))
|
||
(r2 (range ,src2)))
|
||
(let* ((l1 (comp-cstr-smallest-in-range r1))
|
||
(l2 (comp-cstr-smallest-in-range r2))
|
||
(h1 (comp-cstr-greatest-in-range r1))
|
||
(h2 (comp-cstr-greatest-in-range r2)))
|
||
(setf (typeset ,dst) (when (cl-some (lambda (x)
|
||
(comp-subtype-p 'float x))
|
||
(append (typeset src1)
|
||
(typeset src2)))
|
||
'(float))
|
||
(range ,dst) ,@range-body)))))
|
||
|
||
(defun comp-cstr-add-2 (dst src1 src2)
|
||
"Sum SRC1 and SRC2 into DST."
|
||
(comp-cstr-set-range-for-arithm dst src1 src2
|
||
`((,(comp-range-+ l1 l2) . ,(comp-range-+ h1 h2)))))
|
||
|
||
(defun comp-cstr-sub-2 (dst src1 src2)
|
||
"Subtract SRC1 and SRC2 into DST."
|
||
(comp-cstr-set-range-for-arithm dst src1 src2
|
||
(let ((l (comp-range-- l1 h2))
|
||
(h (comp-range-- h1 l2)))
|
||
(if (or (eq l '??) (eq h '??))
|
||
'((- . +))
|
||
`((,l . ,h))))))
|
||
|
||
|
||
;;; Union specific code.
|
||
|
||
(defun comp-cstr-union-homogeneous-no-range (dst &rest srcs)
|
||
"As `comp-cstr-union' but escluding the irange component.
|
||
All SRCS constraints must be homogeneously negated or non-negated."
|
||
|
||
;; Type propagation.
|
||
(setf (comp-cstr-typeset dst)
|
||
(apply #'comp-union-typesets (mapcar #'comp-cstr-typeset srcs)))
|
||
|
||
;; Value propagation.
|
||
(setf (comp-cstr-valset dst)
|
||
(comp-normalize-valset
|
||
(cl-loop
|
||
with values = (mapcar #'comp-cstr-valset srcs)
|
||
;; TODO sort.
|
||
for v in (cl-remove-duplicates (apply #'append values)
|
||
:test #'equal)
|
||
;; We propagate only values those types are not already
|
||
;; into typeset.
|
||
when (cl-notany (lambda (x)
|
||
(comp-subtype-p (type-of v) x))
|
||
(comp-cstr-typeset dst))
|
||
collect v)))
|
||
|
||
dst)
|
||
|
||
(defun comp-cstr-union-homogeneous (range dst &rest srcs)
|
||
"Combine SRCS by union set operation setting the result in DST.
|
||
Do range propagation when RANGE is non-nil.
|
||
All SRCS constraints must be homogeneously negated or non-negated.
|
||
DST is returned."
|
||
(apply #'comp-cstr-union-homogeneous-no-range dst srcs)
|
||
;; Range propagation.
|
||
(setf (comp-cstr-neg dst)
|
||
(when srcs
|
||
(comp-cstr-neg (car srcs)))
|
||
|
||
(comp-cstr-range dst)
|
||
(when (cl-notany (lambda (x)
|
||
(comp-subtype-p 'integer x))
|
||
(comp-cstr-typeset dst))
|
||
(if range
|
||
(apply #'comp-range-union
|
||
(mapcar #'comp-cstr-range srcs))
|
||
'((- . +)))))
|
||
dst)
|
||
|
||
(cl-defun comp-cstr-union-1-no-mem (range &rest srcs)
|
||
"Combine SRCS by union set operation setting the result in DST.
|
||
Do range propagation when RANGE is non-nil.
|
||
Non memoized version of `comp-cstr-union-1'.
|
||
DST is returned."
|
||
(with-comp-cstr-accessors
|
||
(let ((dst (make-comp-cstr)))
|
||
(cl-flet ((give-up ()
|
||
(setf (typeset dst) '(t)
|
||
(valset dst) ()
|
||
(range dst) ()
|
||
(neg dst) nil)
|
||
(cl-return-from comp-cstr-union-1-no-mem dst)))
|
||
|
||
;; Check first if we are in the simple case of all input non-negate
|
||
;; or negated so we don't have to cons.
|
||
(when-let ((res (comp-cstrs-homogeneous srcs)))
|
||
(apply #'comp-cstr-union-homogeneous range dst srcs)
|
||
(cl-return-from comp-cstr-union-1-no-mem dst))
|
||
|
||
;; Some are negated and some are not
|
||
(cl-multiple-value-bind (positives negatives) (comp-split-pos-neg srcs)
|
||
(let* ((pos (apply #'comp-cstr-union-homogeneous range
|
||
(make-comp-cstr) positives))
|
||
;; We'll always use neg as result as this is almost
|
||
;; always necessary for describing open intervals
|
||
;; resulting from negated constraints.
|
||
(neg (apply #'comp-cstr-union-homogeneous range
|
||
(make-comp-cstr :neg t) negatives)))
|
||
;; Type propagation.
|
||
(when (and (typeset pos)
|
||
;; When every pos type is a subtype of some neg ones.
|
||
(cl-every (lambda (x)
|
||
(cl-some (lambda (y)
|
||
(comp-subtype-p x y))
|
||
(append (typeset neg)
|
||
(when (range neg)
|
||
'(integer)))))
|
||
(typeset pos)))
|
||
;; This is a conservative choice, ATM we can't represent such
|
||
;; a disjoint set of types unless we decide to add a new slot
|
||
;; into `comp-cstr' or adopt something like
|
||
;; `intersection-type' `union-type' in SBCL. Keep it
|
||
;; "simple" for now.
|
||
(give-up))
|
||
|
||
;; When every neg type is a subtype of some pos one.
|
||
;; In case return pos.
|
||
(when (and (typeset neg)
|
||
(cl-every (lambda (x)
|
||
(cl-some (lambda (y)
|
||
(comp-subtype-p x y))
|
||
(append (typeset pos)
|
||
(when (range pos)
|
||
'(integer)))))
|
||
(typeset neg)))
|
||
(setf (typeset dst) (typeset pos)
|
||
(valset dst) (valset pos)
|
||
(range dst) (range pos)
|
||
(neg dst) nil)
|
||
(cl-return-from comp-cstr-union-1-no-mem dst))
|
||
|
||
;; Verify disjoint condition between positive types and
|
||
;; negative types coming from values, in case give-up.
|
||
(let ((neg-value-types (nconc (mapcar #'type-of (valset neg))
|
||
(when (range neg)
|
||
'(integer)))))
|
||
(when (cl-some (lambda (x)
|
||
(cl-some (lambda (y)
|
||
(and (not (eq y x))
|
||
(comp-subtype-p y x)))
|
||
neg-value-types))
|
||
(typeset pos))
|
||
(give-up)))
|
||
|
||
;; Value propagation.
|
||
(cond
|
||
((and (valset pos) (valset neg)
|
||
(equal (comp-union-valsets (valset pos) (valset neg))
|
||
(valset pos)))
|
||
;; Pos is a superset of neg.
|
||
(give-up))
|
||
((cl-some (lambda (x)
|
||
(cl-some (lambda (y)
|
||
(comp-subtype-p y x))
|
||
(mapcar #'type-of (valset pos))))
|
||
(typeset neg))
|
||
(give-up))
|
||
(t
|
||
;; pos is a subset or eq to neg
|
||
(setf (valset neg)
|
||
(cl-nset-difference (valset neg) (valset pos)))))
|
||
|
||
;; Range propagation
|
||
(when range
|
||
;; Handle apart (or (integer 1 1) (not (integer 1 1)))
|
||
;; like cases.
|
||
(if (and (range pos) (range neg)
|
||
(equal (range pos) (range neg)))
|
||
(give-up)
|
||
(setf (range neg)
|
||
(comp-range-negation
|
||
(comp-range-union
|
||
(comp-range-negation (range neg))
|
||
(range pos))))))
|
||
|
||
(if (comp-cstr-empty-p neg)
|
||
(setf (typeset dst) (typeset pos)
|
||
(valset dst) (valset pos)
|
||
(range dst) (range pos)
|
||
(neg dst) nil)
|
||
(setf (typeset dst) (typeset neg)
|
||
(valset dst) (valset neg)
|
||
(range dst) (range neg)
|
||
(neg dst) (neg neg)))))
|
||
|
||
;; (not null) => t
|
||
(when (and (neg dst)
|
||
(null (typeset dst))
|
||
(null (valset dst))
|
||
(null (range dst)))
|
||
(give-up)))
|
||
|
||
dst)))
|
||
|
||
(defun comp-cstr-union-1 (range dst &rest srcs)
|
||
"Combine SRCS by union set operation setting the result in DST.
|
||
Do range propagation when RANGE is non-nil.
|
||
DST is returned."
|
||
(with-comp-cstr-accessors
|
||
(let* ((mem-h (if range
|
||
(comp-cstr-ctxt-union-1-mem-range comp-ctxt)
|
||
(comp-cstr-ctxt-union-1-mem-no-range comp-ctxt)))
|
||
(res (or (gethash srcs mem-h)
|
||
(puthash
|
||
(mapcar #'comp-cstr-copy srcs)
|
||
(apply #'comp-cstr-union-1-no-mem range srcs)
|
||
mem-h))))
|
||
(setf (typeset dst) (typeset res)
|
||
(valset dst) (valset res)
|
||
(range dst) (range res)
|
||
(neg dst) (neg res))
|
||
res)))
|
||
|
||
(cl-defun comp-cstr-intersection-homogeneous (dst &rest srcs)
|
||
"Combine SRCS by intersection set operation setting the result in DST.
|
||
All SRCS constraints must be homogeneously negated or non-negated.
|
||
DST is returned."
|
||
|
||
(with-comp-cstr-accessors
|
||
(when (cl-some #'comp-cstr-empty-p srcs)
|
||
(setf (valset dst) nil
|
||
(range dst) nil
|
||
(typeset dst) nil)
|
||
(cl-return-from comp-cstr-intersection-homogeneous dst))
|
||
|
||
(setf (neg dst) (when srcs
|
||
(neg (car srcs))))
|
||
|
||
;; Type propagation.
|
||
(setf (typeset dst)
|
||
(apply #'comp-intersect-typesets
|
||
(mapcar #'comp-cstr-typeset srcs)))
|
||
|
||
;; Value propagation.
|
||
(setf (valset dst)
|
||
(comp-normalize-valset
|
||
(cl-loop
|
||
for src in srcs
|
||
append
|
||
(cl-loop
|
||
for val in (valset src)
|
||
;; If (member value) is subtypep of all other sources then
|
||
;; is good to be colleted.
|
||
when (cl-every (lambda (s)
|
||
(or (memql val (valset s))
|
||
(cl-some (lambda (type)
|
||
(cl-typep val type))
|
||
(typeset s))))
|
||
(remq src srcs))
|
||
collect val))))
|
||
|
||
;; Range propagation.
|
||
(setf (range dst)
|
||
;; Do range propagation only if the destination typeset
|
||
;; doesn't cover it already.
|
||
(unless (cl-some (lambda (type)
|
||
(comp-subtype-p 'integer type))
|
||
(typeset dst))
|
||
(apply #'comp-range-intersection
|
||
(cl-loop
|
||
for src in srcs
|
||
;; Collect effective ranges.
|
||
collect (or (range src)
|
||
(when (cl-some (lambda (s)
|
||
(comp-subtype-p 'integer s))
|
||
(typeset src))
|
||
'((- . +))))))))
|
||
|
||
dst))
|
||
|
||
(cl-defun comp-cstr-intersection-no-mem (&rest srcs)
|
||
"Combine SRCS by intersection set operation.
|
||
Non memoized version of `comp-cstr-intersection-no-mem'."
|
||
(let ((dst (make-comp-cstr)))
|
||
(with-comp-cstr-accessors
|
||
(cl-flet ((return-empty ()
|
||
(setf (typeset dst) ()
|
||
(valset dst) ()
|
||
(range dst) ()
|
||
(neg dst) nil)
|
||
(cl-return-from comp-cstr-intersection-no-mem dst)))
|
||
(when-let ((res (comp-cstrs-homogeneous srcs)))
|
||
(if (eq res 'neg)
|
||
(apply #'comp-cstr-union-homogeneous t dst srcs)
|
||
(apply #'comp-cstr-intersection-homogeneous dst srcs))
|
||
(cl-return-from comp-cstr-intersection-no-mem dst))
|
||
|
||
;; Some are negated and some are not
|
||
(cl-multiple-value-bind (positives negatives) (comp-split-pos-neg srcs)
|
||
(let* ((pos (apply #'comp-cstr-intersection-homogeneous
|
||
(make-comp-cstr) positives))
|
||
(neg (apply #'comp-cstr-intersection-homogeneous
|
||
(make-comp-cstr) negatives)))
|
||
|
||
;; In case pos is not relevant return directly the content
|
||
;; of neg.
|
||
(when (equal (typeset pos) '(t))
|
||
(setf (typeset dst) (typeset neg)
|
||
(valset dst) (valset neg)
|
||
(range dst) (range neg)
|
||
(neg dst) t)
|
||
|
||
;; (not t) => nil
|
||
(when (and (null (valset dst))
|
||
(null (range dst))
|
||
(neg dst)
|
||
(equal '(t) (typeset dst)))
|
||
(setf (typeset dst) ()
|
||
(neg dst) nil))
|
||
|
||
(cl-return-from comp-cstr-intersection-no-mem dst))
|
||
|
||
(when (cl-some
|
||
(lambda (ty)
|
||
(memq ty (typeset neg)))
|
||
(typeset pos))
|
||
(return-empty))
|
||
|
||
;; Some negated types are subtypes of some non-negated one.
|
||
;; Transform the corresponding set of types from neg to pos.
|
||
(cl-loop
|
||
for neg-type in (typeset neg)
|
||
do (cl-loop
|
||
for pos-type in (copy-sequence (typeset pos))
|
||
when (and (not (eq neg-type pos-type))
|
||
(comp-subtype-p neg-type pos-type))
|
||
do (cl-loop
|
||
with found
|
||
for (type . _) in (comp-supertypes neg-type)
|
||
when found
|
||
collect type into res
|
||
when (eq type pos-type)
|
||
do (setf (typeset pos) (cl-union (typeset pos) res))
|
||
(cl-return)
|
||
when (eq type neg-type)
|
||
do (setf found t))))
|
||
|
||
(setf (range pos)
|
||
(comp-range-intersection (range pos)
|
||
(comp-range-negation (range neg)))
|
||
(valset pos)
|
||
(cl-set-difference (valset pos) (valset neg)))
|
||
|
||
;; Return a non negated form.
|
||
(setf (typeset dst) (typeset pos)
|
||
(valset dst) (valset pos)
|
||
(range dst) (range pos)
|
||
(neg dst) nil)))
|
||
dst))))
|
||
|
||
|
||
;;; Entry points.
|
||
|
||
(defun comp-cstr-imm-vld-p (cstr)
|
||
"Return t if one and only one immediate value can be extracted from CSTR."
|
||
(with-comp-cstr-accessors
|
||
(when (and (null (typeset cstr))
|
||
(null (neg cstr)))
|
||
(let* ((v (valset cstr))
|
||
(r (range cstr))
|
||
(valset-len (length v))
|
||
(range-len (length r)))
|
||
(if (and (= valset-len 1)
|
||
(= range-len 0))
|
||
t
|
||
(when (and (= valset-len 0)
|
||
(= range-len 1))
|
||
(let* ((low (caar r))
|
||
(high (cdar r)))
|
||
(and (integerp low)
|
||
(integerp high)
|
||
(= low high)))))))))
|
||
|
||
(defun comp-cstr-imm (cstr)
|
||
"Return the immediate value of CSTR.
|
||
`comp-cstr-imm-vld-p' *must* be satisfied before calling
|
||
`comp-cstr-imm'."
|
||
(declare (gv-setter
|
||
(lambda (val)
|
||
`(with-comp-cstr-accessors
|
||
(if (integerp ,val)
|
||
(setf (typeset ,cstr) nil
|
||
(range ,cstr) (list (cons ,val ,val)))
|
||
(setf (typeset ,cstr) nil
|
||
(valset ,cstr) (list ,val)))))))
|
||
(with-comp-cstr-accessors
|
||
(let ((v (valset cstr)))
|
||
(if (length= v 1)
|
||
(car v)
|
||
(caar (range cstr))))))
|
||
|
||
(defun comp-cstr-fixnum-p (cstr)
|
||
"Return t if CSTR is certainly a fixnum."
|
||
(with-comp-cstr-accessors
|
||
(when (null (neg cstr))
|
||
(when-let (range (range cstr))
|
||
(let* ((low (caar range))
|
||
(high (cdar (last range))))
|
||
(unless (or (eq low '-)
|
||
(< low most-negative-fixnum)
|
||
(eq high '+)
|
||
(> high most-positive-fixnum))
|
||
t))))))
|
||
|
||
(defun comp-cstr-symbol-p (cstr)
|
||
"Return t if CSTR is certainly a symbol."
|
||
(with-comp-cstr-accessors
|
||
(and (null (range cstr))
|
||
(null (neg cstr))
|
||
(or (and (null (valset cstr))
|
||
(equal (typeset cstr) '(symbol)))
|
||
(and (or (null (typeset cstr))
|
||
(equal (typeset cstr) '(symbol)))
|
||
(cl-every #'symbolp (valset cstr)))))))
|
||
|
||
(defsubst comp-cstr-cons-p (cstr)
|
||
"Return t if CSTR is certainly a cons."
|
||
(with-comp-cstr-accessors
|
||
(and (null (valset cstr))
|
||
(null (range cstr))
|
||
(null (neg cstr))
|
||
(equal (typeset cstr) '(cons)))))
|
||
|
||
(defun comp-cstr-= (dst op1 op2)
|
||
"Constraint OP1 being = OP2 setting the result into DST."
|
||
(with-comp-cstr-accessors
|
||
(cl-flet ((relax-cstr (cstr)
|
||
(setf cstr (comp-cstr-shallow-copy cstr))
|
||
;; If can be any float extend it to all integers.
|
||
(when (memq 'float (typeset cstr))
|
||
(setf (range cstr) '((- . +))))
|
||
;; For each float value that can be represented
|
||
;; precisely as an integer add the integer as well.
|
||
(cl-loop
|
||
for v in (valset cstr)
|
||
do
|
||
(when-let* ((ok (floatp v))
|
||
(truncated (ignore-error overflow-error
|
||
(truncate v)))
|
||
(ok (= v truncated)))
|
||
(push (cons truncated truncated) (range cstr))))
|
||
(cl-loop
|
||
with vals-to-add
|
||
for (l . h) in (range cstr)
|
||
;; If an integer range reduces to single value add
|
||
;; its float value too.
|
||
if (eql l h)
|
||
do (push (float l) vals-to-add)
|
||
;; Otherwise can be any float.
|
||
else
|
||
do (cl-pushnew 'float (typeset cstr))
|
||
(cl-return cstr)
|
||
finally (setf (valset cstr)
|
||
(append vals-to-add (valset cstr))))
|
||
(when (memql 0.0 (valset cstr))
|
||
(cl-pushnew -0.0 (valset cstr)))
|
||
(when (memql -0.0 (valset cstr))
|
||
(cl-pushnew 0.0 (valset cstr)))
|
||
cstr))
|
||
(comp-cstr-intersection dst (relax-cstr op1) (relax-cstr op2)))))
|
||
|
||
(defun comp-cstr-> (dst old-dst src)
|
||
"Constraint DST being > than SRC.
|
||
SRC can be either a comp-cstr or an integer."
|
||
(with-comp-cstr-accessors
|
||
(let ((ext-range
|
||
(if (integerp src)
|
||
`((,(1+ src) . +))
|
||
(when-let* ((range (range src))
|
||
(low (comp-cstr-smallest-in-range range))
|
||
(okay (integerp low)))
|
||
`((,(1+ low) . +))))))
|
||
(comp-cstr-set-cmp-range dst old-dst ext-range))))
|
||
|
||
(defun comp-cstr->= (dst old-dst src)
|
||
"Constraint DST being >= than SRC.
|
||
SRC can be either a comp-cstr or an integer."
|
||
(with-comp-cstr-accessors
|
||
(let ((ext-range
|
||
(if (integerp src)
|
||
`((,src . +))
|
||
(when-let* ((range (range src))
|
||
(low (comp-cstr-smallest-in-range range))
|
||
(okay (integerp low)))
|
||
`((,low . +))))))
|
||
(comp-cstr-set-cmp-range dst old-dst ext-range))))
|
||
|
||
(defun comp-cstr-< (dst old-dst src)
|
||
"Constraint DST being < than SRC.
|
||
SRC can be either a comp-cstr or an integer."
|
||
(with-comp-cstr-accessors
|
||
(let ((ext-range
|
||
(if (integerp src)
|
||
`((- . ,(1- src)))
|
||
(when-let* ((range (range src))
|
||
(low (comp-cstr-greatest-in-range range))
|
||
(okay (integerp low)))
|
||
`((- . ,(1- low)))))))
|
||
(comp-cstr-set-cmp-range dst old-dst ext-range))))
|
||
|
||
(defun comp-cstr-<= (dst old-dst src)
|
||
"Constraint DST being > than SRC.
|
||
SRC can be either a comp-cstr or an integer."
|
||
(with-comp-cstr-accessors
|
||
(let ((ext-range
|
||
(if (integerp src)
|
||
`((- . ,src))
|
||
(when-let* ((range (range src))
|
||
(low (comp-cstr-greatest-in-range range))
|
||
(okay (integerp low)))
|
||
`((- . ,low))))))
|
||
(comp-cstr-set-cmp-range dst old-dst ext-range))))
|
||
|
||
(defun comp-cstr-add (dst srcs)
|
||
"Sum SRCS into DST."
|
||
(comp-cstr-add-2 dst (cl-first srcs) (cl-second srcs))
|
||
(cl-loop
|
||
for src in (nthcdr 2 srcs)
|
||
do (comp-cstr-add-2 dst dst src)))
|
||
|
||
(defun comp-cstr-sub (dst srcs)
|
||
"Subtract SRCS into DST."
|
||
(comp-cstr-sub-2 dst (cl-first srcs) (cl-second srcs))
|
||
(cl-loop
|
||
for src in (nthcdr 2 srcs)
|
||
do (comp-cstr-sub-2 dst dst src)))
|
||
|
||
(defun comp-cstr-union-no-range (dst &rest srcs)
|
||
"Combine SRCS by union set operation setting the result in DST.
|
||
Do not propagate the range component.
|
||
DST is returned."
|
||
(apply #'comp-cstr-union-1 nil dst srcs))
|
||
|
||
(defun comp-cstr-union (dst &rest srcs)
|
||
"Combine SRCS by union set operation setting the result in DST.
|
||
DST is returned."
|
||
(apply #'comp-cstr-union-1 t dst srcs))
|
||
|
||
(defun comp-cstr-union-make (&rest srcs)
|
||
"Combine SRCS by union set operation and return a new constraint."
|
||
(apply #'comp-cstr-union (make-comp-cstr) srcs))
|
||
|
||
(defun comp-cstr-intersection (dst &rest srcs)
|
||
"Combine SRCS by intersection set operation setting the result in DST.
|
||
DST is returned."
|
||
(with-comp-cstr-accessors
|
||
(let* ((mem-h (comp-cstr-ctxt-intersection-mem comp-ctxt))
|
||
(res (or (gethash srcs mem-h)
|
||
(puthash
|
||
(mapcar #'comp-cstr-copy srcs)
|
||
(apply #'comp-cstr-intersection-no-mem srcs)
|
||
mem-h))))
|
||
(setf (typeset dst) (typeset res)
|
||
(valset dst) (valset res)
|
||
(range dst) (range res)
|
||
(neg dst) (neg res))
|
||
res)))
|
||
|
||
(defun comp-cstr-intersection-no-hashcons (dst &rest srcs)
|
||
"Combine SRCS by intersection set operation setting the result in DST.
|
||
Non hash consed values are not propagated as values but rather
|
||
promoted to their types.
|
||
DST is returned."
|
||
(with-comp-cstr-accessors
|
||
(apply #'comp-cstr-intersection dst srcs)
|
||
(if (and (neg dst)
|
||
(valset dst)
|
||
(cl-notevery #'symbolp (valset dst)))
|
||
(setf (valset dst) ()
|
||
(typeset dst) '(t)
|
||
(range dst) ()
|
||
(neg dst) nil)
|
||
(let (strip-values strip-types)
|
||
(cl-loop for v in (valset dst)
|
||
unless (symbolp v)
|
||
do (push v strip-values)
|
||
(push (type-of v) strip-types))
|
||
(when strip-values
|
||
(setf (typeset dst) (comp-union-typesets (typeset dst) strip-types)
|
||
(valset dst) (cl-set-difference (valset dst) strip-values)))
|
||
(cl-loop for (l . h) in (range dst)
|
||
when (or (bignump l) (bignump h))
|
||
do (setf (range dst) '((- . +)))
|
||
(cl-return))))
|
||
dst))
|
||
|
||
(defun comp-cstr-intersection-make (&rest srcs)
|
||
"Combine SRCS by intersection set operation and return a new constraint."
|
||
(apply #'comp-cstr-intersection (make-comp-cstr) srcs))
|
||
|
||
(defun comp-cstr-negation (dst src)
|
||
"Negate SRC setting the result in DST.
|
||
DST is returned."
|
||
(with-comp-cstr-accessors
|
||
(cond
|
||
((and (null (valset src))
|
||
(null (range src))
|
||
(null (neg src))
|
||
(equal (typeset src) '(t)))
|
||
(setf (typeset dst) ()
|
||
(valset dst) ()
|
||
(range dst) nil
|
||
(neg dst) nil))
|
||
((and (null (valset src))
|
||
(null (range src))
|
||
(null (neg src))
|
||
(null (typeset src)))
|
||
(setf (typeset dst) '(t)
|
||
(valset dst) ()
|
||
(range dst) nil
|
||
(neg dst) nil))
|
||
(t (setf (typeset dst) (typeset src)
|
||
(valset dst) (valset src)
|
||
(range dst) (range src)
|
||
(neg dst) (not (neg src)))))
|
||
dst))
|
||
|
||
(defun comp-cstr-value-negation (dst src)
|
||
"Negate values in SRC setting the result in DST.
|
||
DST is returned."
|
||
(with-comp-cstr-accessors
|
||
(if (or (valset src) (range src))
|
||
(setf (typeset dst) ()
|
||
(valset dst) (valset src)
|
||
(range dst) (range src)
|
||
(neg dst) (not (neg src)))
|
||
(setf (typeset dst) (typeset src)
|
||
(valset dst) ()
|
||
(range dst) ()))
|
||
dst))
|
||
|
||
(defun comp-cstr-negation-make (src)
|
||
"Negate SRC and return a new constraint."
|
||
(comp-cstr-negation (make-comp-cstr) src))
|
||
|
||
(defun comp-type-spec-to-cstr (type-spec &optional fn)
|
||
"Convert a type specifier TYPE-SPEC into a `comp-cstr'.
|
||
FN non-nil indicates we are parsing a function lambda list."
|
||
(pcase type-spec
|
||
((and (or '&optional '&rest) x)
|
||
(if fn
|
||
x
|
||
(error "Invalid `%s` in type specifier" x)))
|
||
('nil
|
||
(make-comp-cstr :typeset ()))
|
||
('fixnum
|
||
(comp-irange-to-cstr `(,most-negative-fixnum . ,most-positive-fixnum)))
|
||
('boolean
|
||
(comp-type-spec-to-cstr '(member t nil)))
|
||
('integer
|
||
(comp-irange-to-cstr '(- . +)))
|
||
('null (comp-value-to-cstr nil))
|
||
((pred atom)
|
||
(comp-type-to-cstr type-spec))
|
||
(`(or . ,rest)
|
||
(apply #'comp-cstr-union-make
|
||
(mapcar #'comp-type-spec-to-cstr rest)))
|
||
(`(and . ,rest)
|
||
(apply #'comp-cstr-intersection-make
|
||
(mapcar #'comp-type-spec-to-cstr rest)))
|
||
(`(not ,cstr)
|
||
(comp-cstr-negation-make (comp-type-spec-to-cstr cstr)))
|
||
(`(integer ,(and (pred integerp) l) ,(and (pred integerp) h))
|
||
(comp-irange-to-cstr `(,l . ,h)))
|
||
(`(integer * ,(and (pred integerp) h))
|
||
(comp-irange-to-cstr `(- . ,h)))
|
||
(`(integer ,(and (pred integerp) l) *)
|
||
(comp-irange-to-cstr `(,l . +)))
|
||
(`(float ,(pred comp-star-or-num-p) ,(pred comp-star-or-num-p))
|
||
;; No float range support :/
|
||
(comp-type-to-cstr 'float))
|
||
(`(member . ,rest)
|
||
(apply #'comp-cstr-union-make (mapcar #'comp-value-to-cstr rest)))
|
||
(`(function ,args ,ret)
|
||
(make-comp-cstr-f
|
||
:args (mapcar (lambda (x)
|
||
(comp-type-spec-to-cstr x t))
|
||
args)
|
||
:ret (comp-type-spec-to-cstr ret)))
|
||
(_ (error "Invalid type specifier"))))
|
||
|
||
(defun comp-cstr-to-type-spec (cstr)
|
||
"Given CSTR return its type specifier."
|
||
(let ((valset (comp-cstr-valset cstr))
|
||
(typeset (comp-cstr-typeset cstr))
|
||
(range (comp-cstr-range cstr))
|
||
(negated (comp-cstr-neg cstr)))
|
||
|
||
(when valset
|
||
(when (memq nil valset)
|
||
(if (memq t valset)
|
||
(progn
|
||
;; t and nil are values, convert into `boolean'.
|
||
(push 'boolean typeset)
|
||
(setf valset (remove t (remove nil valset))))
|
||
;; Only nil is a value, convert it into a `null' type specifier.
|
||
(setf valset (remove nil valset))
|
||
(push 'null typeset))))
|
||
|
||
;; Form proper integer type specifiers.
|
||
(setf range (cl-loop for (l . h) in range
|
||
for low = (if (integerp l) l '*)
|
||
for high = (if (integerp h) h '*)
|
||
if (and (eq low '*) (eq high '*))
|
||
collect 'integer
|
||
else
|
||
collect `(integer ,low , high))
|
||
valset (cl-remove-duplicates valset))
|
||
|
||
;; Form the final type specifier.
|
||
(let* ((types-ints (append typeset range))
|
||
(res (cond
|
||
((and types-ints valset)
|
||
`((member ,@valset) ,@types-ints))
|
||
(types-ints types-ints)
|
||
(valset `(member ,@valset))
|
||
(t
|
||
;; Empty type specifier
|
||
nil)))
|
||
(final
|
||
(pcase res
|
||
((or `(member . ,rest)
|
||
`(integer ,(pred comp-star-or-num-p)
|
||
,(pred comp-star-or-num-p)))
|
||
(if rest
|
||
res
|
||
(car res)))
|
||
((pred atom) res)
|
||
(`(,_first . ,rest)
|
||
(if rest
|
||
`(or ,@res)
|
||
(car res))))))
|
||
(if negated
|
||
`(not ,final)
|
||
final))))
|
||
|
||
(provide 'comp-cstr)
|
||
|
||
;;; comp-cstr.el ends here
|