naming decisions; bugfix in native construction of pragmas

quil-lang · Sep 26, 2024 · 48c50f9 · 48c50f9
1 parent 8f48bcd
commit 48c50f9
Show file tree

Hide file tree

Showing 2 changed files with 54 additions and 51 deletions.
diff --git a/src/coalton/ast/classical.lisp b/src/coalton/ast/classical.lisp
@@ -1,9 +1,11 @@
 (defpackage #:quil/ast/classical
   (:use #:coalton)
   (:shadow #:And)
+  (:local-nicknames
+   (#:mem #:quil/ast/memory))
   (:export
    #:Arg
-   #:Ref
+   #:Mem
    #:Const
    #:Operation
    #:Not
@@ -31,10 +33,11 @@
 (named-readtables:in-readtable coalton:coalton)
 
 (coalton-toplevel
+
   (define-type (Arg :num)
-    (Ref String Ufix)
+    (Mem mem:Ref)
     (Const :num))
-  
+
   (define-type (Operation :arg)
     ;; Unary
     (Not :arg)

diff --git a/src/coalton/ast/native.lisp b/src/coalton/ast/native.lisp
@@ -9,7 +9,7 @@
    (#:ast #:quil/ast/unresolved)
    (#:macro #:quil/ast/macro)
    (#:gate #:quil/ast/gate)
-   (#:classical #:quil/ast/classical)))
+   (#:op #:quil/ast/classical)))
 
 (in-package #:quil/ast/native)
 
@@ -203,56 +203,56 @@ parameter postion of a gate application."
   (repr :native (cl:or cl-quil:memory-ref cl-quil:constant cl-quil:formal))
   (define-type ClassicalArg)
 
-  (declare raw-classical-arg (classical:Arg :num -> ClassicalArg))
+  (declare raw-classical-arg (op:Arg :num -> ClassicalArg))
   (define (raw-classical-arg arg)
     (match arg
-      ((classical:Ref name loc)
+      ((op:Mem (mem:Ref name loc))
        (lisp ClassicalArg (name loc) (quil:mref name loc)))
-      ((classical:Const n)
+      ((op:Const n)
        (lisp ClassicalArg (n) (quil:constant n)))))
 
-  (declare raw-classical-op (classical:Operation (classical:Arg :num) -> Instruction))
+  (declare raw-classical-op (op:Operation (op:Arg :num) -> Instruction))
   (define (raw-classical-op op)
     (match op
-      ((classical:Neg r)
+      ((op:Neg r)
        (unary-classical-op raw-classical-arg "CLASSICAL-NEGATE" r))
-      ((classical:Not r)
+      ((op:Not r)
        (unary-classical-op raw-classical-arg "CLASSICAL-NOT" r))
 
-      ((classical:Move a b)
+      ((op:Move a b)
        (binary-classical-op raw-classical-arg "CLASSICAL-MOVE" a b))
-      ((classical:Exchange a b)
+      ((op:Exchange a b)
        (binary-classical-op raw-classical-arg "CLASSICAL-EXCHANGE" a b))
-      ((classical:Convert a b)
+      ((op:Convert a b)
        (binary-classical-op raw-classical-arg "CLASSICAL-CONVERT" a b))
-      ((classical:And a b)
+      ((op:And a b)
        (binary-classical-op raw-classical-arg "CLASSICAL-AND" a b))
-      ((classical:IOr a b)
+      ((op:IOr a b)
        (binary-classical-op raw-classical-arg "CLASSICAL-INCLUSIVE-OR" a b))
-      ((classical:XOr a b)
+      ((op:XOr a b)
        (binary-classical-op raw-classical-arg "CLASSICAL-EXCLUSIVE-OR" a b))
-      ((classical:Add a b)
+      ((op:Add a b)
        (binary-classical-op raw-classical-arg "CLASSICAL-ADDITION" a b))
-      ((classical:Sub a b)
+      ((op:Sub a b)
        (binary-classical-op raw-classical-arg "CLASSICAL-SUBTRACTION" a b))
-      ((classical:Mul a b)
+      ((op:Mul a b)
        (binary-classical-op raw-classical-arg "CLASSICAL-MULTIPLICATION" a b))
-      ((classical:Div a b)
+      ((op:Div a b)
        (binary-classical-op raw-classical-arg "CLASSICAL-DIVISION" a b))
 
-      ((classical:Load a b c)
+      ((op:Load a b c)
        (ternary-classical-op raw-classical-arg "CLASSICAL-LOAD" a b c))
-      ((classical:Store a b c)
+      ((op:Store a b c)
        (ternary-classical-op raw-classical-arg "CLASSICAL-STORE" a b c))
-      ((classical:Eq a b c)
+      ((op:Eq a b c)
        (ternary-classical-op raw-classical-arg "CLASSICAL-EQUALITY" a b c))
-      ((classical:Gt a b c)
+      ((op:Gt a b c)
        (ternary-classical-op raw-classical-arg "CLASSICAL-GREATER-THAN" a b c))
-      ((classical:Ge a b c)
+      ((op:Ge a b c)
        (ternary-classical-op raw-classical-arg "CLASSICAL-GREATER-EQUAL" a b c))
-      ((classical:Lt a b c)
+      ((op:Lt a b c)
        (ternary-classical-op raw-classical-arg "CLASSICAL-LESS-THAN" a b c))
-      ((classical:Le a b c)
+      ((op:Le a b c)
        (ternary-classical-op raw-classical-arg "CLASSICAL-LESS-EQUAL" a b c))))
 
   (define (raw-macro-classical-arg arg)
@@ -262,48 +262,48 @@ parameter postion of a gate application."
       ((macro:Actual a)
        (raw-classical-arg a))))
 
-  (declare raw-macro-classical-op (classical:Operation (macro:MaybeFormal (classical:Arg :num)) -> Instruction))
+  (declare raw-macro-classical-op (op:Operation (macro:MaybeFormal (op:Arg :num)) -> Instruction))
   (define (raw-macro-classical-op op)
     (match op
-      ((classical:Neg r)
+      ((op:Neg r)
        (unary-classical-op raw-macro-classical-arg "CLASSICAL-NEGATE" r))
-      ((classical:Not r)
+      ((op:Not r)
        (unary-classical-op raw-macro-classical-arg "CLASSICAL-NOT" r))
 
-      ((classical:Move a b)
+      ((op:Move a b)
        (binary-classical-op raw-macro-classical-arg "CLASSICAL-MOVE" a b))
-      ((classical:Exchange a b)
+      ((op:Exchange a b)
        (binary-classical-op raw-macro-classical-arg "CLASSICAL-EXCHANGE" a b))
-      ((classical:Convert a b)
+      ((op:Convert a b)
        (binary-classical-op raw-macro-classical-arg "CLASSICAL-CONVERT" a b))
-      ((classical:And a b)
+      ((op:And a b)
        (binary-classical-op raw-macro-classical-arg "CLASSICAL-AND" a b))
-      ((classical:IOr a b)
+      ((op:IOr a b)
        (binary-classical-op raw-macro-classical-arg "CLASSICAL-INCLUSIVE-OR" a b))
-      ((classical:XOr a b)
+      ((op:XOr a b)
        (binary-classical-op raw-macro-classical-arg "CLASSICAL-EXCLUSIVE-OR" a b))
-      ((classical:Add a b)
+      ((op:Add a b)
        (binary-classical-op raw-macro-classical-arg "CLASSICAL-ADDITION" a b))
-      ((classical:Sub a b)
+      ((op:Sub a b)
        (binary-classical-op raw-macro-classical-arg "CLASSICAL-SUBTRACTION" a b))
-      ((classical:Mul a b)
+      ((op:Mul a b)
        (binary-classical-op raw-macro-classical-arg "CLASSICAL-MULTIPLICATION" a b))
-      ((classical:Div a b)
+      ((op:Div a b)
        (binary-classical-op raw-macro-classical-arg "CLASSICAL-DIVISION" a b))
 
-      ((classical:Load a b c)
+      ((op:Load a b c)
        (ternary-classical-op raw-macro-classical-arg "CLASSICAL-LOAD" a b c))
-      ((classical:Store a b c)
+      ((op:Store a b c)
        (ternary-classical-op raw-macro-classical-arg "CLASSICAL-STORE" a b c))
-      ((classical:Eq a b c)
+      ((op:Eq a b c)
        (ternary-classical-op raw-macro-classical-arg "CLASSICAL-EQUALITY" a b c))
-      ((classical:Gt a b c)
+      ((op:Gt a b c)
        (ternary-classical-op raw-macro-classical-arg "CLASSICAL-GREATER-THAN" a b c))
-      ((classical:Ge a b c)
+      ((op:Ge a b c)
        (ternary-classical-op raw-macro-classical-arg "CLASSICAL-GREATER-EQUAL" a b c))
-      ((classical:Lt a b c)
+      ((op:Lt a b c)
        (ternary-classical-op raw-macro-classical-arg "CLASSICAL-LESS-THAN" a b c))
-      ((classical:Le a b c)
+      ((op:Le a b c)
        (ternary-classical-op raw-macro-classical-arg "CLASSICAL-LESS-EQUAL" a b c))))
 
   (declare raw-gate-def (String -> (ast:GateDef :num) -> Instruction))
@@ -397,8 +397,8 @@ parameter postion of a gate application."
          (quil::parse-pragma
           (quil::tokenize
            (cl:with-output-to-string (out)
-             (cl:write-string "PRAGMA ")
-             (cl:write-string pstring))))))
+             (cl:write-string "PRAGMA " out)
+             (cl:write-string pstring out))))))
 
       ((macro:Label s)
        (lisp Instruction (s)
@@ -472,8 +472,8 @@ parameter postion of a gate application."
          (quil::parse-pragma
           (quil::tokenize
            (cl:with-output-to-string (out)
-             (cl:write-string "PRAGMA ")
-             (cl:write-string pstring))))))
+             (cl:write-string "PRAGMA " out)
+             (cl:write-string pstring out))))))
 
       ((ast:DeclareMem descriptor)
        (raw-mem-descriptor descriptor))