From 277d51433a92a0c60cc6dac1bac0449c581d59cb Mon Sep 17 00:00:00 2001
From: Alex Wood <aeshtaer@gmail.com>
Date: Thu, 19 Oct 2023 21:36:53 -0400
Subject: [PATCH] Define interface for OPTIMIZE proclamations

The lack of a default is pretty annoying though.
---
 Code/Basic/compilation-environment.lisp | 14 +++++++++++++-
 Code/Trucler/trucler.lisp               |  4 ++++
 Code/clostrum.lisp                      |  1 +
 Code/packages.lisp                      | 10 ++++++----
 4 files changed, 24 insertions(+), 5 deletions(-)

diff --git a/Code/Basic/compilation-environment.lisp b/Code/Basic/compilation-environment.lisp
index 2124994..986866f 100644
--- a/Code/Basic/compilation-environment.lisp
+++ b/Code/Basic/compilation-environment.lisp
@@ -15,7 +15,11 @@
    (type-descriptions
     :initarg :type-descriptions
     :reader type-descriptions
-    :initform (make-hash-table :test #'eq))))
+    :initform (make-hash-table :test #'eq))
+   (optimize-description
+    ;; Unfortunately there's really nothing we can sensibly use as a default here.
+    :initarg :optimize-description
+    :accessor optimize-description)))
 
 (defmethod sys:evaluation-environment (client (env compilation-environment))
   (declare (ignore client))
@@ -65,3 +69,11 @@
      symbol)
   (setf (gethash symbol (type-descriptions env))
         description))
+
+(defmethod sys:optimize-description (client (env compilation-environment))
+  (declare (ignore client))
+  (optimize-description env))
+
+(defmethod (setf sys:optimize-description) (new client (env compilation-environment))
+  (declare (ignore client))
+  (setf (optimize-description env) new))
diff --git a/Code/Trucler/trucler.lisp b/Code/Trucler/trucler.lisp
index 740199a..77cfb79 100644
--- a/Code/Trucler/trucler.lisp
+++ b/Code/Trucler/trucler.lisp
@@ -53,6 +53,10 @@
       (env:function-description
        client (env:evaluation-environment client environment) name)))
 
+(defmethod trucler:describe-optimize
+    (client (environment env:compilation-environment))
+  (env:optimize-description client environment))
+
 (defmethod trucler:describe-block
     (client (environment env:compilation-environment) name)
   (declare (ignore client name))
diff --git a/Code/clostrum.lisp b/Code/clostrum.lisp
index d3e70fc..9723f2f 100644
--- a/Code/clostrum.lisp
+++ b/Code/clostrum.lisp
@@ -46,6 +46,7 @@
 (define-accessor sys:function-description (client environment function-name))
 (define-accessor sys:variable-description (client environment variable-name))
 (define-accessor sys:type-description (client environment type-name))
+(define-accessor sys:optimize-description (client environment))
 
 ;;; High level API
 
diff --git a/Code/packages.lisp b/Code/packages.lisp
index 80901db..218c189 100644
--- a/Code/packages.lisp
+++ b/Code/packages.lisp
@@ -24,7 +24,8 @@
   ;; Proclamations
   (:export #:proclamation)
   ;; Compilation environment accessors
-  (:export #:function-description #:variable-description #:type-description))
+  (:export #:function-description #:variable-description
+           #:type-description #:optimize-description))
 
 ;;; High level API.
 (defpackage #:clostrum
@@ -35,8 +36,8 @@
                           #:symbol-plist)
   (:import-from #:clostrum-sys #:type-expander
                 #:function-description #:variable-description
-                #:type-description #:proclamation #:evaluation-environment
-                #:map-all-packages)
+                #:type-description #:optimize-description #:proclamation
+                #:evaluation-environment #:map-all-packages)
   ;; Protocol classes:
   (:export #:run-time-environment #:compilation-environment)
   ;; Protocol functions:
@@ -65,7 +66,8 @@
   (:shadow #:macroexpand-1 #:macroexpand #:constantp)
   (:export #:macroexpand-1 #:macroexpand #:constantp)
   ;; Compilation environment
-  (:export #:function-description #:variable-description #:type-description)
+  (:export #:function-description #:variable-description
+           #:type-description #:optimize-description)
   ;; Condition types:
   (:export #:attempt-to-set-constant-value
            #:attempt-to-define-special-variable-for-existing-constant