What is the appropriate Racket/Scheme idiom for this code?

Go To StackoverFlow.com

8

I'm new to racket/scheme, so i decided to learn by implemeting an emulator for the DCPU-16, a simple 16 bit processor.

My question is thus: What is a better way to implement my solution?

This is the solution I hacked together to control the cpu's registers. The main point was to allow functions which modify a register to be chained together. For example:

; Increment value stored in register r-id
; returns the updated register
;
; Reg - the register structure 
; (reg-inc Reg 'SP)
(define (reg-inc reg r-id)
    (reg-write reg r-id (+ (reg-read reg r-id) 1 )))

; chain them together
;(reg-inc (reg-inc Reg 'SP)
;         'PC)
;
; returns structure with both 'SP and 'PC incremented

The full text of my register solution is below. My full program is also on github. There is so much repeated logic, I know there must be an easier way:

(struct registers (A B C X Y Z I J SP PC O Pa Pb Paadr Pbadr CLK)
  #:transparent)

(define Reg (registers 0 0 0 0 0 0 0 0 #x10000 0 0 0 0 0 0 0))

(define (reg-name n)
  (case n
    [(0) 'A]
    [(1) 'B]
    [(2) 'C]
    [(3) 'X]
    [(4) 'Y]
    [(5) 'Z]
    [(6) 'I]
    [(7) 'J]
    [(8) 'SP]
    [(9) 'PC]
    [(10) 'O]
    [(11) 'Pa]
    [(12) 'Pb]
    [(13) 'Paadr]
    [(14) 'Pbadr]
    [(15) 'CLK]
    [else (error "Invalid register")]))

(define (reg-id s)
  (cond
    [(eq? 'A s) 0]
    [(eq? 'B s) 1]
    [(eq? 'C s) 2]
    [(eq? 'X s) 3]
    [(eq? 'Y s) 4]
    [(eq? 'Z s) 5]
    [(eq? 'I s) 6]
    [(eq? 'J s) 7]
    [(eq? 'SP s) 8]
    [(eq? 'PC s) 9]
    [(eq? 'O s) 10]
    [(eq? 'Pa s) 11]
    [(eq? 'Pb s) 12]
    [(eq? 'Paadr s) 13]
    [(eq? 'Pbadr s) 14]
    [(eq? 'CLK s) 15]))

(define (reg-read reg r)
  (if (symbol? r)
      (reg-read reg (reg-id r))
      (case r
        [(0) (registers-A reg)]
        [(1) (registers-B reg)]
        [(2) (registers-C reg)]
        [(3) (registers-X reg)]
        [(4) (registers-Y reg)]
        [(5) (registers-Z reg)]
        [(6) (registers-I reg)]
        [(7) (registers-J reg)]
        [(8) (registers-SP reg)]
        [(9) (registers-PC reg)]
        [(10) (registers-O reg)]
        [(11) (registers-Pa reg)]
        [(12) (registers-Pb reg)]
        [(13) (registers-Paadr reg)]
        [(14) (registers-Pbadr reg)]
        [(15) (registers-CLK reg)]
        [else (error "Invalid register")])))

(define (reg-write reg r val)
  (if (symbol? r)
      (reg-write reg (reg-id r) val)
      (let ([mask-val (bitwise-and val #xffff)])
        (case r
          [(0) (struct-copy registers reg [A mask-val])]
          [(1) (struct-copy registers reg [B mask-val])]
          [(2) (struct-copy registers reg [C mask-val])]
          [(3) (struct-copy registers reg [X mask-val])]
          [(4) (struct-copy registers reg [Y mask-val])]
          [(5) (struct-copy registers reg [Z mask-val])]
          [(6) (struct-copy registers reg [I mask-val])]
          [(7) (struct-copy registers reg [J mask-val])]
          [(8) (struct-copy registers reg [SP mask-val])]
          [(9) (struct-copy registers reg [PC mask-val])]
          [(10) (struct-copy registers reg [O mask-val])]
          [(11) (struct-copy registers reg [Pa mask-val])]
          [(12) (struct-copy registers reg [Pb mask-val])]
          [(13) (struct-copy registers reg [Paadr mask-val])]
          [(14) (struct-copy registers reg [Pbadr mask-val])]
          [(15) (struct-copy registers reg [CLK mask-val])]
          [else (error "Invalid register")]))))

Update:

Thanks to oobviat's sugestions I've refactored using lists. The only tricky part was updating a value in the list. I wrote a procedure for map that would update the desired register and leave the others with their original value:

;; a-list of registers and initial values
(define (build-reg)
  '((A . 0)  (B . 0)     (C . 0)      (X . 0)
    (Y . 0)  (Z . 0)     (I . 0)      (J . 0)
    (SP . 0) (PC . 0)    (O . 0)      (Pa . 0)
    (Pb . 0) (Paadr . 0) (Pbadr . 0)  (CLK . 0)))

(define *REF-REG* (build-reg)) ; used to determine structure

(define (reg-name n)
  (if (symbol? n)
      n
      (car (list-ref *REF-REG* n))))

(define (reg-id s)
  (- (length *REF-REG*)
     (length (memf (lambda (arg)
                     (eq? s (car arg)))
                   *REF-REG*))))

(define (reg-write reg r val)
  (let ([r-name (reg-name r)])
    (define (reg-write-helper entry)
      (if (eq? r-name
               (car entry))
          (cons r-name val)
          entry))
    (map reg-write-helper reg)))

(define (reg-read reg r)
  (cdr (assoc (reg-name r) reg)))
2012-04-05 23:34
by Kevin Coffey
Does structs have no introspection procedures? I am sure it does - leppie 2012-04-06 16:25
@leppie, structs don't have their names in the introspection info - Sam Tobin-Hochstadt 2012-04-06 21:11


2

This wasn't written in Racket, so it may not run for you as is.. if it throws errors try specifying the R5RS code type at the top of the file. For simplicity, I would do something like this using an a-list rather than structs.

;; a-list of registers and initial values
(define *reg*
  '((A . 0) (B . 0) (C . 0) (X . 0) (Y . 0) (Z . 0)
    (I . 0) (J . 0) (SP . #X10000) (PC . 0) (O . 0)
    (Pa . 0) (Pb . 0) (Paadr . 0) (Pbadr . 0) (CLK . 0)))

(define (reg-write register val)
  (set-cdr! (assoc register *reg*) val) ;write new value to register
  val) ; return newly written value

(define (reg-read register)
  (cdr (assoc register *reg*)))

(define (reg-inc register)
  (reg-write register (+ 1 (reg-read register))))

;; to do many operations
;; input:  a list of registers
;;    EX:  '(a b x)
(define (do-incs registers)
  (if (null? registers)
      'done       ; return something when the incs are done
      (begin      ; lets you evaluate multiple expressions since `if` doesn't          
        (reg-inc (car registers))
        (do-incs (cdr registers)))))

I'm assuming that Racket has a built in like assoc that returns the proper list from the a-list. Also, note that *reg* is defined as a global variable in this case so that we can just define it once then use set-cdr! to write values to it.

finally, this might do strange things to your SP register. My scheme sees it as 65536.. if that's not right, you may have to add an if to reg-write and reg-read to make sure you're getting the right values there.

<EDIT> So, I read up a little bit on Racket procedures, and this code almost certainly won't run in normal Racket because they apparently have both mutable and non-mutable pairs. The changes you will have to make if you want to run this under Racket and not R5RS are as follows:

Rather than just using a quoted list you will probably need to make your list of registers with the mutable list/pair constructors (define *reg* (mlist (mcons 'A 0) (mcons 'B 0) ... ).

Instead of using set-cdr! the Racket version is set-mcdr! and only works on mutable pairs.</EDIT>

2012-04-06 16:11
by robbyphillips
It does.Taymon 2012-04-06 16:14
Yeah.. figured it was a pretty safe assumption - robbyphillips 2012-04-06 16:41
I wanted to write this without the use of set, to force myself into thinking differently. Your list solution did inspire my new implementation - Kevin Coffey 2012-04-06 18:41
@Kevin Non-destructive functional programming is pretty neat, but to me this case doesn't seem particularly well suited to it since you're returning an entirely new list every time you call reg-write; you never actually write to *reg-ref*. For example if you call (reg-write *reg-ref* 'a 2) it will return a new list => ((A . 2) (B . 0) ...) . But then if you call (reg-read *reg-ref* 'a) you'll get 0. Maybe I just don't fully understand what you're trying to accomplish - robbyphillips 2012-04-06 19:22
@oobivat In my software, the reg-read would be passed in the register list created by reg-write, so the new value could be accessed - Kevin Coffey 2012-04-06 19:30
@KevinCoffey Yeah, I understand that... I didn't mean to say that your code is broken. I am just curious as to why you would choose to do it that way instead of a single register. To me it seems like that would be a more intuitive way to think about the emulator. Would it be possible for me to see more of your code - robbyphillips 2012-04-06 21:06
@oobivat Its all on github. https://github.com/psycocoffey/Babys-First-DCPU1 - Kevin Coffey 2012-04-06 23:02
Ads