(define-module (scmvm vm2)
  #:use-module (ice-9 hash-table)
  #:export (define-instruction-set
             instruction-lookup
             instruction-set-caller
             instruction-name
             instruction-code
             register-set))

;;; Instructions
(define-syntax define-instruction-set
  (syntax-rules (define-instruction)
    [(_ (set-name reg ...) (define-instruction (name opcode) impl ...) ...)
     (define (set-name dispatch)
       (case dispatch
         [(lookup)
          (lambda (lookup)
            (case lookup
              [(name) '(name opcode)] ...
              [else #f]))]
         [(call)
          (lambda (registers)
            (let ([reg (hash-ref registers 'reg)] ...)
              (parameterize ([reg #f] ...)
                (lambda (op)
                  (case op
                    [(opcode) impl ...] ...)))))]))]))

(define (instruction-lookup isa name)
  ((isa 'lookup) name))

(define (instruction-set-caller instruction-set registers)
  ((instruction-set 'call) registers))

(define instruction-name car)
(define instruction-code cadr)

(define (register-set names)
  (alist->hash-table (map (lambda (n) (cons n (make-parameter #f))) names)))