From 48c50f9911bba87e2d9f661b90858b1fd511a058 Mon Sep 17 00:00:00 2001 From: Colin O'Keefe Date: Wed, 25 Sep 2024 20:08:03 -0700 Subject: [PATCH] naming decisions; bugfix in native construction of pragmas --- src/coalton/ast/classical.lisp | 9 ++-- src/coalton/ast/native.lisp | 96 +++++++++++++++++----------------- 2 files changed, 54 insertions(+), 51 deletions(-) diff --git a/src/coalton/ast/classical.lisp b/src/coalton/ast/classical.lisp index 2d6f5d60..bbc8b6b4 100644 --- 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 index 493d9e6d..658a11e8 100644 --- 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))