Rewrite tagged types to be pairs instead of lists

1 files changed, 35 insertions, 33 deletions

diff --git a/atk16_schasm/lib.scm b/atk16_schasm/lib.scm
index 5a1c540..52d9d0d 100644
--- a/atk16_schasm/lib.scm
+++ b/atk16_schasm/lib.scm
@@ -44,7 +44,7 @@
 (define (reg n)
   (cond
    ((or (< n 0) (>= n 16)) (error "invalid arg to reg" n))
-   (else `(reg ,n))))
+   (else (cons 'reg n))))
 
 (define R0  (reg 0))
 (define R1  (reg 1))
@@ -68,37 +68,37 @@
 (define SP (reg 15))
 
 (define (imm n)
-  `(imm ,n))
+  (cons 'imm n))
 
 (define (i16 n)
   (unless (and (<  n (expt 2 15))
 	       (>= n (- (expt 2 15))))
     (error "n does not fit in bounds" n))
-  `(imm ,(modulo n (expt 2 16))))
+  (imm (modulo n (expt 2 16))))
 
 (define (u16 n)
   (unless (and (<  n (expt 2 16))
 	       (>= n 0))
     (error "n does not fit in bounds" n))
-  `(imm ,n))
+  (imm n))
 
 (define (i8 n)
   (unless (and (<  n (expt 2 7))
 	       (>= n (- (expt 2 7))))
     (error "n does not fit in bounds" n))
-  `(imm ,(modulo n (expt 2 16))))
+  (imm (modulo n (expt 2 16))))
 
 (define (u8 n)
   (unless (and (<  n (expt 2 8))
 	       (>= n 0))
     (error "n does not fit in bounds" n))
-  `(imm ,n))
+  (imm n))
 
 (define (alu-op n)
   (unless (and (>= n 0)
 	       (<  n 8))
     (error "invalid arg to alu-op" n))
-  `(alu-op ,n))
+  (cons 'alu-op n))
 
 (define alu-plus  (alu-op 0))
 (define alu-minus (alu-op 1))
@@ -113,7 +113,7 @@
   (unless (and (>= n 0)
 	       (<  n 4))
     (error "invalid arg to flag" n))
-  `(flag ,n))
+  (cons 'flag n))
 
 (define flag-carry    (flag 0))
 (define flag-overflow (flag 1))
@@ -173,19 +173,19 @@
   (if (= mode 0)
       ;; reg mode
       (emit `(4 . 1)			; opcode = 1
-	    `(3 . ,(cadr op))		; alu op
+	    `(3 . ,(val-of op))		; alu op
 	    `(1 . ,mode)		; reg/imm mode
-	    `(4 . ,(cadr lhs))		; lhs
-	    `(4 . ,(cadr rhs)))		; rhs
+	    `(4 . ,(val-of lhs))      	; lhs
+	    `(4 . ,(val-of rhs)))     	; rhs
 
       ;; immediate mode
       (begin
 	(emit `(4 . 1)	       	        ; opcode = 1
-	      `(3 . ,(cadr op))      	; alu op
+	      `(3 . ,(val-of op))      	; alu op
 	      `(1 . ,mode)	       	; reg/imm mode
-	      `(4 . ,(cadr lhs))	; lhs
+	      `(4 . ,(val-of lhs))	; lhs
 	      `(4 . 0))		        ; unused
-	(emit `(16 . ,(cadr rhs))))     ; rhs
+	(emit (val-of rhs)))            ; rhs
       ))
 
 (define (add lhs rhs) (alu (alu-op 0) lhs rhs))
@@ -208,6 +208,9 @@
 	  ((eq? 'imm (type-of rhs)) 1)
 	  (else (error "invalid rhs" rhs))))
 
+  (print lhs)
+  (print rhs)
+
   (if (= m-mode 0)
       ;; reg mode
       (emit `(4 . 2)			; opcode = 2
@@ -215,8 +218,8 @@
 	    `(1 . ,p-mode)		; pop mode
 	    `(1 . 0)                    ; unused
 	    `(1 . ,m-mode)              ; reg/imm mode
-	    `(4 . ,(cadr lhs)) 		; lhs
-	    `(4 . ,(cadr rhs)))		; rhs
+	    `(4 . ,(val-of lhs)) 	; lhs
+	    `(4 . ,(val-of rhs)))	; rhs
 
       ;; immediate mode
       (begin
@@ -225,19 +228,19 @@
 	      `(1 . ,p-mode)		; pop mode
 	      `(1 . 0)                  ; unused
 	      `(1 . ,m-mode)            ; reg/imm mode
-       	      `(4 . ,(cadr lhs))       	; lhs
+       	      `(4 . ,(val-of lhs))      ; lhs
 	      `(4 . 0))		        ; unused
-	(emit `(16 . ,(cadr rhs))))     ; rhs
+	(emit (val-of rhs)))            ; rhs
       ))
 
 (define (mov lhs rhs)
   (unless (eq? 'reg (type-of lhs)) (error "invalid lhs" lhs))
   (unless (eq? 'reg (type-of rhs)) (error "invalid rhs" rhs))
 
-  (emit `(4 . 3)             ; opcode = 3
-	`(4 . 0)             ; unused
-	`(4 . ,(cadr lhs))   ; lhs
-	`(4 . ,(cadr rhs)))) ; rhs
+  (emit `(4 . 3)               ; opcode = 3
+	`(4 . 0)               ; unused
+	`(4 . ,(val-of lhs))   ; lhs
+	`(4 . ,(val-of rhs)))) ; rhs
 
 (define (st lhs rhs #!key (indirect #f) (push #f))
   (unless (eq? 'reg (type-of lhs)) (error "invalid lhs" lhs))
@@ -257,8 +260,8 @@
 	    `(1 . ,p-mode)		; pop mode
 	    `(1 . 0)                    ; unused
 	    `(1 . ,m-mode)              ; reg/imm mode
-	    `(4 . ,(cadr lhs)) 		; lhs
-	    `(4 . ,(cadr rhs)))		; rhs
+	    `(4 . ,(val-of lhs)) 	; lhs
+	    `(4 . ,(val-of rhs)))	; rhs
 
       ;; immediate mode
       (begin
@@ -267,9 +270,9 @@
 	      `(1 . ,p-mode)		; pop mode
 	      `(1 . 0)                  ; unused
 	      `(1 . ,m-mode)            ; reg/imm mode
-       	      `(4 . ,(cadr lhs))       	; lhs
+       	      `(4 . ,(val-of lhs))      ; lhs
 	      `(4 . 0))		        ; unused
-	(emit `(16 . ,(cadr rhs))))     ; rhs
+	(emit (val-of rhs)))            ; rhs
       ))
 
 (define (br flag offset #!key (asserted #t))
@@ -281,11 +284,11 @@
 	  (else (error "invalid asserted bool" asserted))))
 
   (unless (eq? 'imm (type-of offset)) (error "invalid offset" offset))
-  (define imm (cadr offset))
+  (define imm (val-of offset))
   (unless (< imm (expt 2 8)) (error "offset too large" imm))
 
   (emit `(4 . 5)            ; opcode = 5
-	`(2 . ,(cadr flag)) ; flag selector
+	`(2 . ,(val-of flag)) ; flag selector
 	`(1 . 0)            ; unused
 	`(1 . ,set)         ; asserted (set / not set)
 	`(8 . ,imm))        ; offset
@@ -323,11 +326,10 @@
 
 ;; Utils
 
-(define (type-of v)
-  (if (and (list? v)
-	   (> (length v) 0))
-      (car v)
-      #f))
+(define (type-of pair)
+  (if (pair? pair) (car pair) (error "not a pair" pair)))
+(define (val-of pair)
+  (if (pair? pair) (cdr pair) (error "not a pair" pair)))
 
 (define (assocar k alist)
   (let ((v (assoc k alist)))