Modularity refinements; more explicit types

the introduction of the macro module includes a subeset of
instructions from the unresolved module. macro instrutions can accept
formal arguments. They were made in order to distinguish instructions
that can appear within DEFCIRCUITS from those that appear in
executable code.

Classical instructions have also been given a numeric type argument

cl-quil.asd

@@ -163,6 +163,20 @@
                (:file "print-program")
                (:file "initialize-standard-gates")))
 
+(asdf:defsystem #:coalton-quil/ast
+  :description "Coalton implementation cl-quil/ast" 
+  :depends-on (#:cl-quil #:coalton)
+  :pathname "src/coalton/ast/"
+  :serial t
+  :components ((:file "memory")
+               (:file "expression")
+               (:file "classical")
+               (:file "gate")
+               (:file "macro")
+               (:file "unresolved")
+               (:file "native")))
+
+
 (asdf:defsystem #:cl-quil/chip-library
   :description "Holds definitions for various chip ISAs."
   :license "Apache License 2.0 (See LICENSE.txt)"

src/coalton/ast/classical.lisp

@@ -0,0 +1,60 @@
+(defpackage #:quil/ast/classical
+  (:use #:coalton)
+  (:shadow #:And)
+  (:export
+   #:Arg
+   #:Ref
+   #:Const
+   #:Operation
+   #:Not
+   #:Neg
+   #:Move
+   #:Exchange
+   #:Convert
+   #:And
+   #:IOr
+   #:XOr
+   #:Add
+   #:Sub
+   #:Mul
+   #:Div
+   #:Load
+   #:Store
+   #:Eq
+   #:Gt
+   #:Ge
+   #:Lt
+   #:Le))
+
+(in-package #:quil/ast/classical)
+
+(named-readtables:in-readtable coalton:coalton)
+
+(coalton-toplevel
+  (define-type (Arg :num)
+    (Ref String Ufix)
+    (Const :num))
+
+  (define-type (Operation :arg)
+    ;; Unary
+    (Not :arg)
+    (Neg :arg)
+    ;; Binary
+    (Move :arg :arg)
+    (Exchange :arg :arg)
+    (Convert :arg :arg)
+    (And :arg :arg)
+    (IOr :arg :arg)
+    (XOr :arg :arg)
+    (Add :arg :arg)
+    (Sub :arg :arg)
+    (Mul :arg :arg)
+    (Div :arg :arg)
+    ;; Ternary
+    (Load :arg :arg :arg)
+    (Store :arg :arg :arg)
+    (Eq :arg :arg :arg)
+    (Gt :arg :arg :arg)
+    (Ge :arg :arg :arg)
+    (Lt :arg :arg :arg)
+    (Le :arg :arg :arg)))

src/coalton/ast/expression.lisp

@@ -0,0 +1,35 @@
+(defpackage #:quil/ast/expression
+  (:use #:coalton)
+  (:export
+   #:Expr
+   #:Add
+   #:Sub
+   #:Mul
+   #:Div
+   #:Pow
+   #:Neg
+   #:Const
+   #:Call
+   #:Var
+   #:Ref))
+
+(in-package #:quil/ast/expression)
+
+(named-readtables:in-readtable coalton:coalton)
+
+(coalton-toplevel
+
+  (define-type (Expr :num)
+    "Arithmetic expressions appearing in gate application parameter
+     positions and in gate definitions.  In the latter case, Memory
+     references may not appear."
+    (Add (Expr :num) (Expr :num))
+    (Sub (Expr :num) (Expr :num))
+    (Mul (Expr :num) (Expr :num))
+    (Div (Expr :num) (Expr :num))
+    (Pow (Expr :num) (Expr :num))
+    (Neg (Expr :num))
+    (Const :num)
+    (Call String (Expr :num))
+    (Var String)
+    (Ref String Ufix)))

src/coalton/ast/gate.lisp

@@ -0,0 +1,84 @@
+(defpackage #:quil/ast/gate
+  (:use #:coalton)
+  (:local-nicknames
+   (#:expr #:quil/ast/expression))
+  (:export
+   #:Gate
+   #:I
+   #:X
+   #:Y
+   #:Z
+   #:H
+   #:S
+   #:T
+   #:RX
+   #:RY
+   #:RZ
+   #:Phase
+   #:CNOT
+   #:CZ
+   #:SWAP
+   #:ISWAP
+   #:SQISWAP
+   #:CSWAP
+   #:CCNOT
+   #:PSWAP
+   #:PISWAP
+   #:XY
+   #:CAN
+   #:BLOCH
+   #:DAGGER
+   #:CONTROLLED
+   #:FORKED))
+
+(in-package #:quil/ast/gate)
+
+(named-readtables:in-readtable coalton:coalton)
+
+(coalton-toplevel 
+
+  (define-type (Gate :num :arg)
+    ;; User-defeind Gate
+    (Gate  String                       ; Name
+           (List (expr:Expr :num))           ; Params
+           (List :arg))                 ; Args
+    ;; Built-in Gates
+    ;; -- one qubit gates
+    (I :arg)
+    (X :arg)
+    (Y :arg)
+    (Z :arg)
+    (H :arg)
+    (S :arg)
+    (T :arg)
+
+    ;; -- one parameter one qubit gates
+    (RX (expr:Expr :num) :arg)
+    (RY (expr:Expr :num) :arg)
+    (RZ (expr:Expr :num) :arg)
+    (Phase (expr:Expr :num) :arg)    
+
+    ;; -- two qubit gates
+    (CNOT :arg :arg)
+    (CZ :arg :arg)
+    (SWAP :arg :arg)
+    (ISWAP :arg :arg)
+    (SQISWAP :arg :arg)
+
+    ;; -- three qubit gates
+    (CSWAP :arg :arg :arg)
+    (CCNOT :arg :arg :arg)
+
+    ;; -- parameterized two qubit gates
+    (PSWAP (expr:Expr :num) :arg :arg)
+    (PISWAP (expr:Expr :num) :arg :arg)
+    (XY (expr:Expr :num) :arg :arg)
+
+    ;; -- multi-parameter gates
+    (CAN (expr:Expr :num) (expr:Expr :num) (expr:Expr :num) :arg :arg)
+    (BLOCH (expr:Expr :num) (expr:Expr :num) (expr:Expr :num) :arg)
+
+    ;; --operators
+    (DAGGER (Gate :num :arg))
+    (CONTROLLED :arg (Gate :num :arg))
+    (FORKED :arg (List (expr:Expr :num)) (Gate :num :arg))))

src/coalton/ast/macro.lisp

@@ -0,0 +1,67 @@
+(defpackage #:quil/ast/macro
+  (:use #:coalton)
+  (:documentation
+   "A subset of instructions which are permitted to appear inside circuit
+    definitions.")
+  (:local-nicknames
+   (#:classical #:quil/ast/classical)
+   (#:gate #:quil/ast/gate)
+   (#:mem #:quil/ast/memory)
+   (#:expr #:quil/ast/expression))
+  (:export
+   #:MaybeFormal
+   #:Actual
+   #:Formal
+
+   #:Instruction
+   #:ApplyGate
+   #:ApplyOp
+   #:ApplyCirc
+   #:Pragma
+   #:Label
+   #:Jump
+   #:JumpWhen
+   #:JumpUnless
+   #:Noop
+   #:Halt
+   #:Wait
+   #:ResetAll
+   #:Reset
+   #:Measure
+   #:MeasureDiscard))
+
+(in-package #:quil/ast/macro)
+
+(named-readtables:in-readtable coalton:coalton)
+
+(coalton-toplevel
+
+  (define-type (MaybeFormal :t)
+    (Actual :t)
+    (Formal String))
+
+  (define-type (Instruction :num)
+    (ApplyGate (gate:Gate :num (MaybeFormal Ufix)))
+    (ApplyOp (classical:Operation (MaybeFormal (classical:Arg :num))))
+    (ApplyCirc String                        ; name
+               (List (expr:Expr :num))       ; params 
+               (List (MaybeFormal Ufix))     ; qubit arguments
+               (List (Maybeformal mem:Ref))) ; memory refernce arguments
+
+    (Pragma String)
+    (Label String)
+    (Jump String)
+    (JumpWhen String (MaybeFormal mem:Ref))
+    (JumpUnless String (MaybeFormal mem:Ref))
+
+    Noop
+    Halt
+    Wait
+
+    ResetAll
+    (Reset (MaybeFormal Ufix ))
+
+    (Measure (MaybeFormal Ufix) (MaybeFormal mem:Ref))
+    (MeasureDiscard (MaybeFormal Ufix))))
+
+

src/coalton/ast/memory.lisp

@@ -0,0 +1,63 @@
+(defpackage #:quil/ast/memory
+  (:use #:coalton)
+  (:export
+   #:QuilType
+   #:QuilBit
+   #:QuilOctet
+   #:QuilInteger
+   #:QuilReal
+   #:Ref
+   #:Offset
+   #:offset-type
+   #:offset-amount
+   #:Descriptor
+   #:ref-to
+   #:ref-to-at
+   #:single
+   ))
+
+(in-package #:quil/ast/memory)
+
+(named-readtables:in-readtable coalton:coalton)
+
+(coalton-toplevel
+
+  (repr :enum)
+  (define-type QuilType
+    "A valid data type for Quil memory."
+    QuilBit QuilOctet QuilInteger QuilReal)
+
+  (define-type Ref
+    "A Memory Reference"
+    (Ref String                         ; name
+         Ufix))                         ; position
+
+  (define-type Offset
+    "Used in declaring offsets into shared memory declarations"
+    (Offset QuilType Ufix))
+
+  (define (offset-type (Offset type _)) type)
+  (define (offset-amount (Offset _ amount)) amount)
+
+  (define-type Descriptor
+    (Descriptor
+     String
+     QuilType
+     Ufix
+     Boolean
+     (List Offset)))
+
+  ;;; conveniences
+
+  (define (ref-to (Descriptor name _ _ _ _))
+    (Ref name 0))
+
+  (define (ref-to-at (Descriptor name _ _ _ _) i)
+    (Ref name i))
+
+  (define (single name type)
+    (Descriptor name type 1 False Nil))
+
+
+
+)