(setf (nth 1 dv) t))))))
(define-obsolete-function-alias 'cconv-analyse-form #'cconv-analyze-form "25.1")
-
+(defun cconv-fv (form lexvars dynvars)
+ "Return the list of free variables in FORM.
+LEXVARS is the list of statically scoped vars in the context
+and DYNVARS is the list of dynamically scoped vars in the context.
+Returns a pair (LEXV . DYNV) of those vars actually used by FORM."
+ (let* ((fun
+ ;; Wrap FORM into a function because the analysis code we
+ ;; have only computes freevars for functions.
+ ;; In practice FORM is always already of the form
+ ;; #'(lambda ...), so optimize for this case.
+ (if (and (eq 'function (car-safe form))
+ (eq 'lambda (car-safe (cadr form)))
+ ;; To get correct results, FUN needs to be a "simple lambda"
+ ;; without nested forms that aren't part of the body. :-(
+ (not (assq 'interactive (cadr form)))
+ (not (assq ':documentation (cadr form))))
+ form
+ `#'(lambda () ,form)))
+ (analysis-env (mapcar (lambda (v) (list v nil nil nil nil)) lexvars))
+ (cconv--dynbound-variables dynvars)
+ (byte-compile-lexical-variables nil)
+ (cconv--dynbindings nil)
+ (cconv-freevars-alist '())
+ (cconv-var-classification '()))
+ (let* ((body (cddr (cadr fun))))
+ ;; Analyze form - fill these variables with new information.
+ (cconv-analyze-form fun analysis-env)
+ (setq cconv-freevars-alist (nreverse cconv-freevars-alist))
+ (unless (equal (if (eq :documentation (car-safe (car body)))
+ (cdr body) body)
+ (caar cconv-freevars-alist))
+ (message "BOOH!\n%S\n%S"
+ body (caar cconv-freevars-alist)))
+ (cl-assert (equal (if (eq :documentation (car-safe (car body)))
+ (cdr body) body)
+ (caar cconv-freevars-alist)))
+ (let ((fvs (nreverse (cdar cconv-freevars-alist)))
+ (dyns (delq nil (mapcar (lambda (var) (car (memq var dynvars)))
+ (delete-dups cconv--dynbindings)))))
+ (cons fvs dyns)))))
+
+(defun cconv-make-interpreted-closure (fun env)
+ (cl-assert (eq (car-safe fun) 'lambda))
+ (let ((lexvars (delq nil (mapcar #'car-safe env))))
+ (if (null lexvars)
+ ;; The lexical environment is empty, so there's no need to
+ ;; look for free variables.
+ `(closure ,env . ,(cdr fun))
+ ;; We could try and cache the result of the macroexpansion and
+ ;; `cconv-fv' analysis. Not sure it's worth the trouble.
+ (let* ((form `#',fun)
+ (expanded-form
+ (let ((lexical-binding t) ;; Tell macros which dialect is in use.
+ ;; Make the macro aware of any defvar declarations in scope.
+ (macroexp--dynvars
+ (if macroexp--dynvars
+ (append env macroexp--dynvars) env)))
+ (macroexpand-all form macroexpand-all-environment)))
+ ;; Since we macroexpanded the body, we may as well use that.
+ (expanded-fun-cdr
+ (pcase expanded-form
+ (`#'(lambda . ,cdr) cdr)
+ (_ (cdr fun))))
++
+ (dynvars (delq nil (mapcar (lambda (b) (if (symbolp b) b)) env)))
+ (fvs (cconv-fv expanded-form lexvars dynvars))
+ (newenv (nconc (mapcar (lambda (fv) (assq fv env)) (car fvs))
+ (cdr fvs))))
+ ;; Never return a nil env, since nil means to use the dynbind
+ ;; dialect of ELisp.
+ `(closure ,(or newenv '(t)) . ,expanded-fun-cdr)))))
+
+
(provide 'cconv)
;;; cconv.el ends here
(forward-char))))) ; over the terminating "]" or other close paren.
nil)
- (re-search-forward
+(defun c-forward-c++-module-name (limit)
+ ;; Is there a C++20 module name at point? If so, return a cons of the start
+ ;; and end of that name, in which case point will be moved over the name and
+ ;; following whitespace. Otherwise nil will be returned and point will be
+ ;; unmoved. This function doesn't regard a partition as part of the name.
+ ;; The entire construct must end not after LIMIT.
+ (when (and
+ (looking-at c-module-name-re)
+ (<= (match-end 0) limit)
+ (not (looking-at c-keywords-regexp)))
+ (goto-char (match-end 0))
+ (prog1 (cons (match-beginning 0) (match-end 0))
+ (c-forward-syntactic-ws limit))))
+
+(defun c-forward-c++-module-partition-name (limit)
+ ;; Is there a C++20 module partition name (starting with its colon) at
+ ;; point? If so return a cons of the start and end of the name, not
+ ;; including the colon, in which case point will be move to after the name
+ ;; and following whitespace. Otherwise nil will be returned and point not
+ ;; moved. The entire construct must end not after LIMIT.
+ (when (and
+ (eq (char-after) ?:)
+ (progn
+ (forward-char)
+ (c-forward-syntactic-ws limit)
+ (looking-at c-module-name-re))
+ (<= (match-end 0) limit)
+ (not (looking-at c-keywords-regexp)))
+ (goto-char (match-end 0))
+ (prog1 (cons (match-beginning 0) (match-end 0))
+ (c-forward-syntactic-ws limit))))
+
+(defun c-font-lock-c++-modules (limit)
+ ;; Fontify the C++20 module stanzas, characterized by the keywords `module',
+ ;; `export' and `import'. Note that this has to be done by a function (as
+ ;; opposed to regexps) due to the presence of optional C++ attributes.
+ ;;
+ ;; This function will be called from font-lock for a region bounded by POINT
+ ;; and LIMIT, as though it were to identify a keyword for
+ ;; font-lock-keyword-face. It always returns NIL to inhibit this and
+ ;; prevent a repeat invocation. See elisp/lispref page "Search-based
+ ;; Fontification".
+ (while (and (< (point) limit)
++ (re-search-forward
+ "\\<\\(module\\|export\\|import\\)\\>\\(?:[^_$]\\|$\\)"
+ limit t))
+ (goto-char (match-end 1))
+ (let (name-bounds pos beg end
+ module-names) ; A list of conses of start and end
+ ; of pertinent module names
+ (unless (c-skip-comments-and-strings limit)
+ (when
+ (cond
+ ;; module foo...; Note we don't handle module; or module
+ ;; :private; here, since they don't really need handling.
+ ((save-excursion
+ (when (equal (match-string-no-properties 1) "export")
+ (c-forward-syntactic-ws limit)
+ (re-search-forward "\\=\\(module\\)\\>\\(?:[^_$]\\|$\\)"
+ limit t))
+ (and (equal (match-string-no-properties 1) "module")
+ (< (point) limit)
+ (progn (c-forward-syntactic-ws limit)
+ (setq name-bounds (c-forward-c++-module-name
+ limit)))
+ (setq pos (point))))
+ (push name-bounds module-names)
+ (goto-char pos)
+ ;; Is there a partition name?
+ (when (setq name-bounds (c-forward-c++-module-partition-name
+ limit))
+ (push name-bounds module-names))
+ t)
+
+ ;; import
+ ((save-excursion
+ (when (equal (match-string-no-properties 1) "export")
+ (c-forward-syntactic-ws limit)
+ (re-search-forward "\\=\\(import\\)\\>\\(?:[^_$]\\|$\\)"
+ limit t))
+ (and (equal (match-string-no-properties 1) "import")
+ (< (point) limit)
+ (progn (c-forward-syntactic-ws limit)
+ (setq pos (point)))))
+ (goto-char pos)
+ (cond
+ ;; import foo;
+ ((setq name-bounds (c-forward-c++-module-name limit))
+ (push name-bounds module-names)
+ t)
+ ;; import :foo;
+ ((setq name-bounds (c-forward-c++-module-partition-name limit))
+ (push name-bounds module-names)
+ t)
+ ;; import "foo";
+ ((and (eq (char-after) ?\")
+ (setq pos (point))
+ (c-safe (c-forward-sexp) t)) ; Should already have string face.
+ (when (eq (char-before) ?\")
+ (setq beg pos
+ end (point)))
+ (c-forward-syntactic-ws limit)
+ t)
+ ;; import <foo>;
+ ((and (looking-at "<\\(?:\\\\.\\|[^\\\n\r\t>]\\)*\\(>\\)?")
+ (< (match-end 0) limit))
+ (setq beg (point))
+ (goto-char (match-end 0))
+ (when (match-end 1)
+ (setq end (point)))
+ (if (featurep 'xemacs)
+ (c-put-font-lock-face
+ (1+ beg) (if end (1- end) (point)) font-lock-string-face)
+ (c-put-font-lock-face
+ beg (or end (point)) font-lock-string-face))
+ (c-forward-syntactic-ws limit)
+ t)
+ (t nil)))
+
+ ;; export
+ ;; There is no fontification to be done here, but we need to
+ ;; skip over the declaration or declaration sequence.
+ ((save-excursion
+ (when (equal (match-string-no-properties 0) "export")
+ (c-forward-syntactic-ws limit)
+ (setq pos (point))))
+ (goto-char (point))
+ (if (eq (char-after) ?{)
+ ;; Declaration sequence.
+ (unless (and (c-go-list-forward nil limit)
+ (eq (char-before) ?}))
+ (goto-char limit)
+ nil)
+ ;; Single declaration
+ (unless (c-end-of-decl-1)
+ (goto-char limit)
+ nil)))) ; Nothing more to do, here.
+
+ ;; Optional attributes?
+ (while (and (c-looking-at-c++-attribute)
+ (< (match-end 0) limit))
+ (goto-char (match-end 0))
+ (c-forward-syntactic-ws limit))
+ ;; Finally, there must be a semicolon.
+ (if (and (< (point) limit)
+ (eq (char-after) ?\;))
+ (progn
+ (forward-char)
+ ;; Fontify any module names we've encountered.
+ (dolist (name module-names)
+ (c-put-font-lock-face (car name) (cdr name)
+ c-reference-face-name)))
+ ;; No semicolon, so put warning faces on any delimiters.
+ (when beg
+ (c-put-font-lock-face beg (1+ beg) font-lock-warning-face))
+ (when end
+ (c-put-font-lock-face (1- end) end font-lock-warning-face))))))))
(c-lang-defconst c-simple-decl-matchers
"Simple font lock matchers for types and declarations. These are used
projects / emacs.git / commitdiff