QuickChick testing for dupe

Author: lemonidas

langs/dupe-qc/Makefile

@@ -0,0 +1,26 @@
+UNAME := $(shell uname)
+.PHONY: test
+
+ifeq ($(UNAME), Darwin)
+  format=macho64
+else
+  format=elf64
+endif
+
+%.run: %.o main.o
+	gcc main.o $< -o $@
+
+main.o: main.c types.h
+	gcc -c main.c -o main.o
+
+%.o: %.s
+	nasm -f $(format) -o $@ $<
+
+%.s: %.rkt
+	racket -t compile-file.rkt -m $< > $@
+
+clean:
+	rm *.o *.s *.run
+
+test: example.run
+	@test "$(shell ./example.run)" = "$(shell racket example.rkt)"

langs/dupe-qc/ast.rkt

@@ -0,0 +1,13 @@
+#lang racket
+(provide Int Bool Prim1 If)
+
+;; type Expr =
+;; | (Int Integer)
+;; | (Bool Boolean)
+;; | (Prim1 Op Expr)
+;; | (If Expr Expr Expr)
+;; type Op = 'add1 | 'sub1 | 'zero?
+(struct Int (i)       #:prefab)
+(struct Bool (b)      #:prefab)
+(struct Prim1 (p e)   #:prefab)
+(struct If (e1 e2 e3) #:prefab)

langs/dupe-qc/compile-file.rkt

@@ -0,0 +1,13 @@
+#lang racket
+(provide main)
+(require "parse.rkt" "compile.rkt" a86/printer)
+
+;; String -> Void
+;; Compile contents of given file name,
+;; emit asm code on stdout
+(define (main fn)
+  (let ((p (open-input-file fn)))
+    (begin
+      (read-line p) ; ignore #lang racket line
+      (displayln (asm-string (compile (parse (read p)))))
+      (close-input-port p))))

langs/dupe-qc/compile.rkt

@@ -0,0 +1,52 @@
+#lang racket
+(provide (all-defined-out))
+(require "ast.rkt" "types.rkt" a86/ast)
+
+;; Expr -> Asm
+(define (compile e)
+  (prog (Label 'entry)
+        (compile-e e)
+        (Ret)))
+
+;; Expr -> Asm
+(define (compile-e e)
+  (match e
+    [(Int i)           (compile-integer i)]
+    [(Bool b)          (compile-boolean b)]
+    [(Prim1 p e)       (compile-prim p e)]
+    [(If e1 e2 e3)     (compile-if e1 e2 e3)]))
+
+;; Integer -> Asm
+(define (compile-integer i)
+  (seq (Mov 'rax (value->bits i))))
+
+;; Boolean -> Asm
+(define (compile-boolean b)
+  (seq (Mov 'rax (value->bits b))))
+
+;; Op Expr -> Asm
+(define (compile-prim p e)
+  (seq (compile-e e)
+       (match p
+         ['add1 (Add 'rax (value->bits 1))]
+         ['sub1 (Sub 'rax (value->bits 1))]
+         ['zero?
+          (let ((l1 (gensym 'nzero)))
+            (seq (Cmp 'rax 0)
+                 (Mov 'rax val-true)
+                 (Je l1)
+                 (Mov 'rax val-false)
+                 (Label l1)))]))) 
+
+;; Expr Expr Expr -> Asm
+(define (compile-if e1 e2 e3)
+  (let ((l1 (gensym 'if))
+        (l2 (gensym 'if)))
+    (seq (compile-e e1)
+         (Cmp 'rax val-false)
+         (Je l1)
+         (compile-e e2)
+         (Jmp l2)
+         (Label l1)
+         (compile-e e3)
+         (Label l2))))

langs/dupe-qc/compile/help.rkt

@@ -0,0 +1,15 @@
+#lang racket
+(provide (all-defined-out))
+
+;; -> [List Label Label]
+;; Guaranteed to be unique on each call
+(define gen-if-labels
+  (let ((i 0))
+    (λ ()
+      (set! i (add1 i))
+      (list (lab "f" i)
+            (lab "x" i)))))
+
+;; String Integer -> Symbol
+(define (lab s i)
+  (string->symbol (string-append "if_" s "_" (number->string i))))

langs/dupe-qc/correct.rkt

@@ -0,0 +1,12 @@
+#lang racket
+(provide (all-defined-out))
+(require rackunit
+         "interp.rkt"
+         "compile.rkt"
+         "types.rkt"
+         a86/interp)
+
+(define (check-correctness e)
+  (with-handlers ([exn:fail? void])
+    (check-eqv? (interp e)
+                (bits->value (asm-interp (compile e))))))