A modest proposal

langs/abscond/compile.rkt

@@ -1,15 +1,23 @@
 #lang racket
-(provide compile)
-(require "ast.rkt" a86/ast)
-
-;; Expr -> Asm
-(define (compile e)
-  (prog (Global 'entry)
-        (Label 'entry)
-        (compile-e e)
-        (Ret)))
-
-;; Expr -> Asm
-(define (compile-e e)
-  (match e
-    [(Int i) (seq (Mov 'rax i))]))
+(provide compile abscond-compiler)
+(require "ast.rkt" "../a86/ast.rkt")
+
+(define abscond-compiler
+  (class object%
+    (super-new)
+
+    ;; Expr -> Asm
+    (define/public (compile e)
+      (prog (Global 'entry)
+            (Label 'entry)
+            (compile-e e)
+            (Ret)))
+
+    ;; Expr -> Asm
+    (define/public (compile-e e)
+      (match e
+        [(Int i) (seq (Mov 'rax i))]))))
+
+(define compile
+  (let ([compiler (new abscond-compiler)])
+    (λ (p) (send compiler compile p))))

langs/blackmail/ast.rkt

@@ -1,9 +1,8 @@
 #lang racket
+(require "../abscond/ast.rkt")
 (provide Int Prim1)
 
-;; type Expr =
-;; | (Int Integer)
+;; type Expr = ...
 ;; | (Prim1 Op Expr)
 ;; type Op = 'add1 | 'sub1
-(struct Int (i)     #:prefab)
 (struct Prim1 (p e) #:prefab)

langs/blackmail/compile.rkt

@@ -1,27 +1,27 @@
 #lang racket
-(provide (all-defined-out))
-(require "ast.rkt" a86/ast)
+(provide compile blackmail-compiler)
+(require "ast.rkt" "../a86/ast.rkt"
+         "../abscond/compile.rkt")
 
-;; Expr -> Asm
-(define (compile e)
-  (prog (Global 'entry)
-        (Label 'entry)
-        (compile-e e)
-        (Ret)))
+(define blackmail-compiler
+  (class abscond-compiler
+    (super-new)
 
-;; Expr -> Asm
-(define (compile-e e)
-  (match e
-    [(Prim1 p e) (compile-prim1 p e)]
-    [(Int i)     (compile-integer i)]))
+    (inherit compile)
 
-;; Op Expr -> Asm
-(define (compile-prim1 p e)
-  (seq (compile-e e)
-       (match p
-         ['add1 (Add 'rax 1)]
-         ['sub1 (Sub 'rax 1)])))
+    ;; Expr -> Asm
+    (define/override (compile-e e)
+      (match e
+        [(Prim1 p e) (compile-prim1 p e)]
+        [_ (super compile-e e)]))
 
-;; Integer -> Asm
-(define (compile-integer i)
-  (seq (Mov 'rax i)))
+    ;; Op Expr -> Asm
+    (define (compile-prim1 p e)
+      (seq (compile-e e)
+           (match p
+             ['add1 (Add 'rax 1)]
+             ['sub1 (Sub 'rax 1)])))))
+
+(define compile
+  (let ([compiler (new blackmail-compiler)])
+    (λ (p) (send compiler compile p))))

langs/con/ast.rkt

@@ -1,11 +1,7 @@
 #lang racket
+(require "../blackmail/ast.rkt")
 (provide Int Prim1 IfZero)
 
-;; type Expr =
-;; | (Int Integer)
-;; | (Prim1 Op Expr)
+;; type Expr = ...
 ;; | (IfZero Expr Expr Expr)
-;; type Op = 'add1 | 'sub1
-(struct Int (i)           #:prefab)
-(struct Prim1 (p e)       #:prefab)
 (struct IfZero (e1 e2 e3) #:prefab)

langs/con/compile.rkt

@@ -1,34 +1,33 @@
 #lang racket
-(provide (all-defined-out))
-(require "ast.rkt" a86/ast "compile-prim.rkt")
+(provide compile con-compiler)
+(require "ast.rkt" "../a86/ast.rkt"
+         "../blackmail/compile.rkt")
 
-;; Expr -> Asm
-(define (compile e)
-  (prog (Global 'entry)
-        (Label 'entry)
-        (compile-e e)
-        (Ret)))
+(define con-compiler
+  (class blackmail-compiler
+    (super-new)
 
-;; Expr -> Asm
-(define (compile-e e)
-  (match e
-    [(Int i)           (compile-integer i)]
-    [(Prim1 p e)       (compile-prim1 p (compile-e e))]
-    [(IfZero e1 e2 e3) (compile-ifzero e1 e2 e3)]))
+    (inherit compile)
 
-;; Integer -> Asm
-(define (compile-integer i)
-  (seq (Mov 'rax i)))
+    ;; Expr -> Asm
+    (define/override (compile-e e)
+      (match e
+        [(IfZero e1 e2 e3) (compile-ifzero e1 e2 e3)]
+        [_ (super compile-e e)]))
 
-;; Expr Expr Expr -> Asm
-(define (compile-ifzero e1 e2 e3)
-  (let ((l1 (gensym 'if))
-        (l2 (gensym 'if)))
-    (seq (compile-e e1)
-         (Cmp 'rax 0)
-         (Je l1)
-         (compile-e e3)
-         (Jmp l2)
-         (Label l1)
-         (compile-e e2)
-         (Label l2))))
+    ;; Expr Expr Expr -> Asm
+    (define (compile-ifzero e1 e2 e3)
+      (let ((l1 (gensym 'if))
+            (l2 (gensym 'if)))
+        (seq (compile-e e1)
+             (Cmp 'rax 0)
+             (Je l1)
+             (compile-e e3)
+             (Jmp l2)
+             (Label l1)
+             (compile-e e2)
+             (Label l2))))))
+
+(define compile
+  (let ([compiler (new con-compiler)])
+    (λ (p) (send compiler compile p))))