lensy-assembly*

lensy-assembly*.rkt

#lang racket
(require lens)

#| UTILITY |#
;------------

(struct/lens Processor (A X Y Z C PC MEM) #:transparent)

#| OPS |#
;--------

;switch to try using operand arguments instead of processor so they can be curried

(require racket/stxparam
         syntax/parse/define)

(define-syntax-parameter the-processor #f)

(define mode #f)
(define lens-view #f)
(define lens-set #f)
(define Processor-A-Lens #f)
(define Processor-C-Lens #f)

(begin-for-syntax
  (define (raise-undefined-location-alias-error id stx)
    (raise-syntax-error (syntax-e id) "undefined" stx)))

(define-simple-macro
  (define-location-alias id:id (~optional (~seq #:default lens:id)))
  (~?
   (define-syntax-parameter id (λ (_) #'(lens-view lens the-processor)))
   (define-syntax-parameter id
     (λ (stx) (raise-undefined-location-alias-error #'id stx)))))

(define-simple-macro (let-location-alias ([id:id lens:id] ...) body ...)
  (syntax-parameterize ([id (λ (_) #'(lens-view lens the-processor))] ...)
    body ...))
                                         
(define-location-alias A #:default Processor-A-Lens)
(define-location-alias M)
(define-location-alias X)
(define-location-alias Y)
(define-location-alias C #:default Processor-C-Lens)
(define-location-alias Z)
(define-location-alias I)
(define-location-alias D)
(define-location-alias B)
(define-location-alias V)
(define-location-alias N)

(define-simple-macro (:= dst src)
  (λ (processor)
    (define local-M (mode processor))
    (let-location-alias
     ([M local-M])
     (syntax-parameterize
         ([the-processor (make-rename-transformer #'processor)])
       (lens-set dst processor src)))))

(define (MODE-IMM processor)
  (lens-compose (vector-ref-lens 1) Processor-MEM-lens))

(define (ADC-IMM processor) 
  (define mode MODE-IMM)
  ((:= A (+ A M C)) processor))

(define (ADC-IMM* processor)
 (define M (MODE-IMM processor))
 (lens-set Processor-A-lens processor (+ (lens-view Processor-A-lens processor)
                                         (lens-view M processor)
                                         (lens-view Processor-C-lens processor))))

(define p (Processor 0 2 0 #f 1 0 (vector-immutable #xA9 #x2A)))

(ADC-IMM p)