(defpackage #:sarcasm.instr
  (:use #:cl #:sarcasm.types)
  (:shadow cl:return cl:if cl:block cl:loop cl:t)
  (:local-nicknames
   (#:a #:alexandria-2))
  (:export
   ;; generic readers functions on every instruction 
   #:instr-name
   #:instr-code
   #:instr-type))

(in-package #:sarcasm.instr)

(defclass instr () ())

(eval-when (:compile-toplevel :load-toplevel :execute)
  (let ((defined (make-hash-table :test #'eql)))
    (defun expand-instr-plist (plist)
      (destructuring-bind (&key instr code type) plist
        (let* ((class-name
                 ;; `select` names two instructions, so we add this
                 ;; machinery to check for two instructions with the
                 ;; same name, and to append `_` to the class name
                 ;; whenever name collision is detected
                 (let ((class-name (intern (string-upcase (first instr)))))
                   (cl:if (gethash class-name defined)
                          (intern (format nil "~a_" class-name))
                          class-name)))
               (immediates
                 (cl:loop
                    :for arg :in (rest instr)
                    :for slot-name := (intern (string-upcase arg))
                    :for reader := (intern (format nil "~a-~a" class-name slot-name))
                    :for initarg := (a:make-keyword slot-name)
                    :collect `(,slot-name
                               :reader ,reader
                               :initarg ,initarg
                               :initform (error "~a required" ',slot-name)))))

          (setf (gethash class-name defined) cl:t)

          `(progn
             (format cl:t "DEFINING ~A~%" ',class-name)
             (defclass ,class-name (instr)
               ((instr-name
                 :allocation :class
                 :type string
                 :initform ,(first instr)
                 :reader instr-name)
                (instr-code
                 :allocation :class
                 :type (vector (unsigned-byte 8) ,(length code))
                 :initform (make-array ,(length code)
                                       :element-type '(unsigned-byte 8)
                                       :initial-contents ',code))
                (instr-type
                 :allocation :class
                 :type stacksig
                 :initform ',type)
                ,@immediates)

               ,@(when (not immediates)
                   '((:metaclass sarcasm.util::singleton))))
           
             (export '(,class-name
                       ,@(mapcar #'first immediates)
                       ,@(mapcar #'third immediates)))))))))

(macrolet ((create-instr-classes (raw)
             `(progn
                ,@(mapcar #'expand-instr-plist raw))))
  (create-instr-classes #.sarcasm.raw-instrs:raw-instrs))