Learn how easy it is to sync an existing GitHub or Google Code repo to a SourceForge project! See Demo

Close

[e90b2f]: src / cmp / cmpenv-declaim.lsp Maximize Restore History

Download this file

cmpenv-declaim.lsp    58 lines (53 with data), 2.5 kB

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
;;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*-
;;;;
;;;; Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
;;;; Copyright (c) 1990, Giuseppe Attardi.
;;;; Copyright (c) 2010, Juan Jose Garcia-Ripoll
;;;;
;;;; This program is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Library General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 2 of the License, or (at your option) any later version.
;;;;
;;;; See file '../Copyright' for full details.
;;;;
;;;; CMPENV-DECLAIM -- Proclamations local to the current file
;;;;
;;;; One implementation of DECLAIM that uses the compiler environment
;;;; providing a "base" set of entries that all other environments
;;;; stem from.
;;;;
(in-package #-ecl-new "COMPILER" #+ecl-new "C-ENV")
(defun process-declaim-args (args)
(flet ((add-variables (env types specials)
(loop for name in specials
unless (assoc name types)
do (let ((v (c1make-global-variable name :kind 'special)))
(setf env (cmp-env-register-var v env nil))))
(loop for (name . type) in types
for specialp = (or (sys:specialp name) (member name specials))
for kind = (if specialp 'SPECIAL 'GLOBAL)
for v = (c1make-global-variable name :type type :kind kind)
do (setf env (cmp-env-register-var v env nil)))
env))
(multiple-value-bind (body specials types ignored others doc all)
(c1body `((DECLARE ,@args)) nil)
(when ignored
(cmpwarn "IGNORE/IGNORABLE declarations in DECLAIM are ignored"))
(reduce #'add-one-declaration others
:initial-value (add-variables *cmp-env* types specials))
(reduce #'add-one-declaration others
:initial-value (add-variables *cmp-env-root* types specials)))))
(defmacro declaim (&rest declarations)
`(locally (declare (notinline mapc))
(ext:with-backend
:c/c++ (eval-when (:compile-toplevel)
(c::process-declaim-args ',declarations))
:bytecodes (eval-when (:compile-toplevel)
(mapc 'proclaim ',declarations)))
(eval-when (:load-toplevel :execute)
(mapc 'proclaim ',declarations))))
(defmacro ext::c-declaim (&rest declarations)
`(ext:with-backend
:c/c++ (eval-when (:compile-toplevel)
(c::process-declaim-args ',declarations))))