Added initial Gabriel Benchmarks

benchmarks/README.md

@@ -0,0 +1,7 @@
+# To run Coalton Benchmarks:
+
+`(ql:quickload :coalton/benchmarks)` or `(asdf:load-system :coalton/benchmarks)`
+
+`(in-package #:coalton-benchmarks)`
+
+`(run-benchmarks)`

benchmarks/gabriel-benchmarks/stak.lisp

@@ -0,0 +1,78 @@
+;;;; gabriel-benchmarks/stak.lisp
+;;;;
+;;;;
+
+(in-package #:coalton-benchmarks)
+
+(define-benchmark stak ()
+  (declare (optimize speed))
+  (loop :repeat 1000
+        :do (with-benchmark-sampling
+              (coalton-benchmarks/native:stak 18 12 6)))
+  (report trivial-benchmark::*current-timer*))
+
+(define-benchmark stak-lisp ()
+  (declare (optimize speed))
+  (loop :repeat 1000
+        :do (with-benchmark-sampling
+              (lisp-stak 18 12 6)))
+  (report trivial-benchmark::*current-timer*))
+
+;;;
+;;;
+;;;
+
+
+(defvar x)
+(defvar y)
+(defvar z)
+
+(declaim (ftype (function () fixnum) stak-aux))
+(defun stak-aux ()
+  (if (not (< y x))
+      z
+      (let ((x (let ((x (1- x))
+                     (y y)
+                     (z z))
+                 (stak-aux)))
+            (y (let ((x (1- y))
+                     (y z)
+                     (z x))
+                 (stak-aux)))
+            (z (let ((x (1- z))
+                     (y x)(z y))
+                 (stak-aux))))
+        (stak-aux))))
+
+(declaim (ftype (function (fixnum) fixnum) lisp-stak))
+(defun lisp-stak (x y z)
+  (stak-aux))
+
+;;;
+;;;
+;;;
+
+
+(cl:in-package #:coalton-benchmarks/native)
+
+(cl:declaim (cl:optimize (cl:speed 3) (cl:safety 0)))
+
+(coalton-toplevel
+
+ (declare stak (IFix -> IFix -> IFix -> IFix))
+ (define (stak x y z)
+     (if (not (< y x))
+         z
+         (let ((x1 (let ((x2 (1- x))
+                         (y2 y)
+                         (z2 z))
+                     (stak x2 y2 z2)))
+               (y1 (let ((x2 (1- y))
+                         (y2 z)
+                         (z2 x))
+                     (stak x2 y2 z2)))
+               (z1 (let ((x2 (1- z))
+                         (y2 x)
+                         (z2 y))
+                     (stak x2 y2 z2))))
+           (stak x1 y1 z1)))))

benchmarks/gabriel-benchmarks/tak.lisp

@@ -0,0 +1,41 @@
+;;;; gabriel-benchmarks/tak.lisp
+;;;;
+;;;; 
+
+(cl:in-package #:coalton-benchmarks)
+
+(define-benchmark tak ()
+  (declare (optimize speed))
+  (loop :repeat 1000
+        :do (with-benchmark-sampling
+              (coalton:coalton (coalton-benchmarks/native:tak 18 12 6))))
+  (report trivial-benchmark::*current-timer*))
+
+(define-benchmark tak-lisp ()
+  (declare (optimize speed))
+  (loop :repeat 1000
+        :do (with-benchmark-sampling
+              (lisp-tak 18 12 6)))
+  (report trivial-benchmark::*current-timer*))
+
+(declaim (ftype (function (fixnum fixnum fixnum) fixnum) lisp-tak))
+(defun lisp-tak (x y z)
+  (if (not (< y x))
+      z
+      (lisp-tak (lisp-tak (1- x) y z)
+                (lisp-tak (1- y) z x)
+                (lisp-tak (1- z) x y))))
+
+(cl:in-package #:coalton-benchmarks/native)
+
+(cl:declaim (cl:optimize (cl:speed 3) (cl:safety 0)))
+
+(coalton-toplevel
+
+  (declare tak (IFix -> IFix -> IFix -> IFix))
+  (define (tak x y z)
+    (if (not (< y x))
+        z
+        (tak (tak (1- x) y z)
+             (tak (1- y) z x)
+             (tak (1- z) x y)))))

benchmarks/gabriel-benchmarks/takl.lisp

@@ -0,0 +1,88 @@
+;;;; gabriel-benchmarks/takl.lisp
+;;;;
+;;;;
+
+(cl:in-package #:coalton-benchmarks)
+
+(define-benchmark takl ()
+  (declare (optimize speed))
+  (loop :repeat 1000
+        :do (with-benchmark-sampling
+              (coalton-benchmarks/native:takl 18 12 6)))
+  (report trivial-benchmark::*current-timer*))
+
+(define-benchmark takl-lisp ()
+  (declare (optimize speed))
+  (loop :repeat 1000
+        :do (with-benchmark-sampling
+              (lisp-takl 18 12 6)))
+  (report trivial-benchmark::*current-timer*))
+
+;;;
+;;;
+;;;
+
+(declaim (ftype (function (fixnum) list) listn))
+(defun listn (n)
+  (if (not (= 0 n))
+      (cons n (listn (1- n)))))
+
+(declaim (ftype (function (list list) boolean)))
+(defun shorterp (x y)
+  (and y (or (null x)
+             (shorterp (cdr x)
+                       (cdr y)))))
+
+(declaim (ftype (function (list list list) list)))
+(defun mas (x y z)
+  (if (not (shorterp y x))
+      z
+      (mas (mas (cdr x)
+                y z)
+           (mas (cdr y)
+                z x)
+           (mas (cdr z)
+                x y))))
+
+(declaim (ftype (function (fixnum fixnum fixnum) list)))
+(defun lisp-takl (x y z)
+  (mas (listn x) (listn y) (listn z)))
+
+;;;
+;;;
+;;;
+
+
+(cl:in-package #:coalton-benchmarks/native)
+
+(cl:declaim (cl:optimize (cl:speed 3) (cl:safety 0)))
+
+(coalton-toplevel
+
+  (declare listn (UFix -> (List UFix)))
+  (define (listn n)
+    (if (not (== n 0))
+        (Cons n (listn (1- n)))
+        Nil))
+
+  (declare shorterp ((List UFix) -> (List UFix) -> Boolean))
+  (define (shorterp x y)
+    (and (not (coalton-library/list:null? y))
+         (or (coalton-library/list:null? x)
+             (shorterp (coalton-library/list:cdr x)
+                       (coalton-library/list:cdr y)))))
+
+  (declare mas ((List UFix) -> (List UFix) -> (List UFix) -> (List UFix)))
+  (define (mas x y z)
+    (if (not (shorterp y x))
+        z
+        (mas (mas (coalton-library/list:cdr x)
+                  y z)
+             (mas (coalton-library/list:cdr y)
+                  z x)
+             (mas (coalton-library/list:cdr z)
+                  x y))))
+
+  (declare takl (UFix -> UFix -> UFix -> (List UFix)))
+  (define (takl x y z)
+    (mas (listn x) (listn y) (listn z))))