Checking extern type for externs in expressions

src/cl-quil.lisp

@@ -224,6 +224,7 @@ In the presence of multiple definitions with a common signature, a signal is rai
   (check-type string string)
   (let* ((*memory-region-names* nil)
          (*names-declared-extern* +builtin-externs+)
+         (*expression-externs* +builtin-externs+)
          (tok-lines (tokenize string)))
     (loop :with parsed-program := nil
           :until (endp tok-lines) :do

src/parser.lisp

@@ -902,6 +902,18 @@ FORMAL objects) which shadow memory names.")
                          :qubit qubit
                          :address (parse-memory-or-formal-token address-tok))))))
 
+
+(defun process-pragma-extern-signature (pragma)
+  "If the PRAGMA is a signature of a function that does not mutate
+arguments and that has a return type, then push its name into
+*EXPRESSION-EXTERNS*.  Otherwise remove its name from that list."
+  (with-slots (extern-name value-type param-types) pragma
+    (cond ((and value-type (loop :for param :in param-types :never (find :mut param)))
+           (pushnew extern-name *expression-externs* :test #'equal))
+          (t
+           (setf *expression-externs* (delete extern-name *expression-externs* :test #'equal))))))
+
+
 (defun parse-pragma (tok-lines)
   "Parse a PRAGMA out of the lines of tokens TOK-LINES."
   (match-line ((op :PRAGMA) word &rest word-toks) tok-lines
@@ -911,22 +923,27 @@ FORMAL objects) which shadow memory names.")
               (:NAME (token-payload word))
               (otherwise
                (quil-parse-error "Expected PRAGMA expected :NAME or :EXTERN token.")))))
+      (let ((pragma 
+              (multiple-value-bind (words non-words)
+                  (take-until (lambda (tok) (not (member (token-type tok) '(:NAME :INTEGER)))) word-toks)
+                (setf words (cons first-payload (mapcar #'token-payload words)))
+                (cond
+                  ((null non-words)
+                   (make-pragma words))
 
-      (multiple-value-bind (words non-words)
-          (take-until (lambda (tok) (not (member (token-type tok) '(:NAME :INTEGER)))) word-toks)
-        (setf words (cons first-payload (mapcar #'token-payload words)))
-        (cond
-          ((null non-words)
-           (make-pragma words))
+                  ((endp (cdr non-words))
+                   (let ((last-tok (first non-words)))
+                     (unless (eql ':STRING (token-type last-tok))
+                       (disappointing-token-error last-tok "a terminating string"))
+                     (make-pragma words (token-payload last-tok))))
 
-          ((endp (cdr non-words))
-           (let ((last-tok (first non-words)))
-             (unless (eql ':STRING (token-type last-tok))
-               (disappointing-token-error last-tok "a terminating string"))
-             (make-pragma words (token-payload last-tok))))
+                  (t
+                   (quil-parse-error "Unexpected tokens near the end of a PRAGMA."))))))
 
-          (t
-           (quil-parse-error "Unexpected tokens near the end of a PRAGMA.")))))))
+        (when (typep pragma 'pragma-extern-signature)
+          (process-pragma-extern-signature pragma))
+
+        pragma))))
 
 (defun parse-include (tok-lines)
   "Parse an INCLUDE out of the lines of tokens TOK-LINES."
@@ -1701,6 +1718,9 @@ When ALLOW-EXPRESSIONS is set, we allow for general arithmetic expressions in a
 extern so that they can be recognized as valid function names during
 expression and CALL application parsing.")
 
+  (defvar *expression-externs*)
+  (setf (documentation '*expression-externs* 'variable)
+        "Names of externs that are permitted to appear in expressions.")
 
   (defvar *quil<->lisp-functions* nil)
   (setf (documentation '*quil<->lisp-functions* 'variable)
@@ -1827,19 +1847,29 @@ name a Lisp function. "
       (declare (ignore i0))
       (list head a b)))
 
-
-
-
   (defun declared-extern-p (name)
     "Checks that a function has been declared extern."
     (find name *names-declared-extern* :test #'string-equal))
 
-  (defun validate-function (func-name)
+  (defun allowed-in-expression-p (name)
+    "Checks that an function name is declared extern has a known type that
+is permitted to appear in extern expressions."
+    (and (declared-extern-p name)
+         (find name *expression-externs* :test #'string-equal)))
+
+  (defun validate-expression-function (func-name)
     "Return the lisp symbol that corresponds to the Quil function named
      FUNC-NAME, or signal a QUIL-PARSE-ERROR if FUNC-NAME is invalid."
-    (or (and (declared-extern-p func-name)
-             (quil-function->lisp-symbol func-name))
-        (quil-parse-error "Invalid function name: ~A." func-name)))
+    (unless (declared-extern-p func-name)
+      (error "No function called ~a has been declared." func-name))
+
+    (unless (allowed-in-expression-p func-name)
+      (error "No type has been declared for ~a. Functions appearing in expressions
+must be known to return a value and to not mutate their arguments." func-name))
+
+    (or (quil-function->lisp-symbol func-name)
+        (error "The function ~a has not been registered with the compiler, we cannot
+evaluate calls to it within expressions." func-name)))
 
   (defun find-or-make-parameter-symbol (param)
     (let ((found (assoc (param-name param)
@@ -1893,7 +1923,7 @@ name a Lisp function. "
    (:NAME :LEFT-PAREN expr-list :RIGHT-PAREN
           (lambda (f i0 xs i1)
             (declare (ignore i0 i1))
-            (let ((f (validate-function f)))
+            (let ((f (validate-expression-function f)))
               (cons f xs))))
    (:LEFT-PAREN expr :RIGHT-PAREN
                 (lambda (i0 x i1)

src/pragmas.lisp

@@ -224,7 +224,7 @@ Expected syntax: PRAGMA NON_VOLATILE identifier")
 
 Expected syntax: PRAGMA EXTERN extern-name \"TYPE? \( (var : mut? TYPE)+ \)")
   (:global t)
-  (:slots extern-name value-type param-types mut-arg-positions)
+  (:slots extern-name value-type param-types)
   (:words name)
   (:freeform-string function-signature-string)
   (:initialization