;;; -*- mode: Lisp; Syntax: Common-Lisp; -*- ;;; ;;; Copyright (c) 2009 by the authors. ;;; ;;; See LICENCE for details. (in-package :hu.dwim.excosy.test) ;;;;;; ;;; Test (def test test/simple (machine input result) (bind ((ast (read-excosy machine input)) (output (print-excosy machine ast nil))) (is (string= input output)) (string= result (print-excosy machine (interpret-excosy machine ast) nil)) (string= result (print-excosy machine (execute-excosy machine (compile-excosy machine ast)) nil)))) (def test test/primitive/nothing (machine) ;; TODO: (test/simple machine "" "")) (def test test/primitive/abstraction (machine) (test/simple machine "(abstraction)" "(abstraction)")) (def test test/primitive/abstraction-application (machine) (test/simple machine "((abstraction))" "")) (def test test/primitive/single-argument-abstraction (machine) (test/simple machine "(abstraction (x) x)" "(abstraction (x) x)")) (def test test/primitive/single-argument-abstraction-application (machine) (test/simple machine "((abstraction (x) x) (abstraction (y) y))" "(abstraction (y) y)") (test/simple machine "(((abstraction (x) x) (abstraction (y) y)) (abstraction (z) z))" "(abstraction (z) z)")) (def test test/primitive/boolean (machine) (test/simple machine "true" "true") (test/simple machine "false" "false")) (def test test/primitive/integer (machine) (test/simple machine "0" "0") (test/simple machine "42" "42")) (def test test/virtual-machine/1 () (bind ((machine (make-virtual-machine '(abstraction/ast)))) (test/primitive/abstraction machine))) (def test test/virtual-machine/2 () (bind ((machine (make-virtual-machine '(abstraction/ast false/ast true/ast if/ast))) (true-ast (hu.dwim.excosy::find-well-known-abstraction (hu.dwim.excosy::configuration-of machine) :true)) (false-ast (hu.dwim.excosy::find-well-known-abstraction (hu.dwim.excosy::configuration-of machine) :false)) (ast (make-instance 'hu.dwim.excosy::if/ast :condition false-ast :then-branch (make-instance 'hu.dwim.excosy::abstraction/ast) :else-branch true-ast))) (is (eq true-ast (interpret-excosy machine ast))) (compile-excosy machine ast) #+nil(is (eq true-ast (execute-excosy machine (compile-excosy machine ast)))))) (def test test/virtual-machine/3 () (bind ((machine (make-virtual-machine '(abstraction/ast false/ast true/ast if/ast integer/ast))) (ast (make-instance 'hu.dwim.excosy::integer/ast :value 1))) (is (eq ast (interpret-excosy machine ast))) (is (eq ast (execute-excosy machine (compile-excosy machine ast)))))) (def test test/virtual-machine/4 () (bind ((machine (make-virtual-machine '(abstraction/ast false/ast true/ast if/ast integer/ast primitive-abstraction/ast))) (left-argument (make-instance 'hu.dwim.excosy::integer/ast :value 1)) (right-argument (make-instance 'hu.dwim.excosy::integer/ast :value 2)) (ast (make-instance 'hu.dwim.excosy::primitive-application/ast :arguments (list left-argument right-argument) :interpreter-function 'hu.dwim.excosy::interpret-primitive-application/add/native-integer+native-integer))) #+nil(is (eq ast (interpret-excosy machine ast))) (assemble-excosy machine (compile-excosy machine ast)))) (def test test/virtual-machine/5 () (bind ((machine (make-virtual-machine '(abstraction/ast false/ast true/ast if/ast integer/ast primitive-abstraction/ast))) (ast (make-instance 'hu.dwim.excosy::with-labels/ast :labelled-asts (list (make-instance 'hu.dwim.excosy::label/ast :name :loop :body (make-instance 'hu.dwim.excosy::goto-label/ast :name :loop)))))) #+nil(is (eq ast (interpret-excosy machine ast))) (assemble-excosy machine (compile-excosy machine ast)))) (def test test/virtual-machine/6 () #+nil (with-labels (label :loop (sequentially (if #t (primitive-add 1 2) #f) (goto-label :loop)))) (bind ((machine (make-virtual-machine '(abstraction/ast false/ast true/ast if/ast integer/ast primitive-abstraction/ast))) (true-ast (hu.dwim.excosy::find-well-known-abstraction (hu.dwim.excosy::configuration-of machine) :true)) (false-ast (hu.dwim.excosy::find-well-known-abstraction (hu.dwim.excosy::configuration-of machine) :false)) (ast (make-instance 'hu.dwim.excosy::with-labels/ast :labelled-asts (list (make-instance 'hu.dwim.excosy::label/ast :name :loop :body (make-instance 'hu.dwim.excosy::sequentially/ast :body (list (make-instance 'hu.dwim.excosy::if/ast :condition true-ast :then-branch (make-instance 'hu.dwim.excosy::primitive-application/ast :arguments (list (make-instance 'hu.dwim.excosy::integer/ast :value 1) (make-instance 'hu.dwim.excosy::integer/ast :value 2)) :interpreter-function 'hu.dwim.excosy::interpret-primitive-application/add/native-integer+native-integer) :else-branch false-ast) (make-instance 'hu.dwim.excosy::goto-label/ast :name :loop)))))))) #+nil(is (eq ast (interpret-excosy machine ast))) (build-excosy machine (compile-excosy machine ast)))) (def test test/virtual-machine/7 () (read-excosy nil "(let (counter 10) (block down (labels (entry (if (= counter 0) (goto-label exit) (sequentially (set counter (- counter 1)) (goto-label entry)))) (exit (return-from-block counter)))))")) (def test test/virtual-machine/8 () #+nil (read-excosy nil "(primitive-application/ast write-byte-to-standard-output (primitive-application/ast add/native-integer+native-integer (primitive-application/ast read-byte-from-standard-input) (primitive-application/ast read-byte-from-standard-input)))") (bind ((machine (make-virtual-machine nil)) (read-byte-ast-1 (make-instance 'hu.dwim.excosy::primitive-application/ast :interpreter-function 'hu.dwim.excosy::interpret-primitive-application/read-byte-from-standard-input)) (read-byte-ast-2 (make-instance 'hu.dwim.excosy::primitive-application/ast :interpreter-function 'hu.dwim.excosy::interpret-primitive-application/read-byte-from-standard-input)) (ast (make-instance 'hu.dwim.excosy::primitive-application/ast :interpreter-function 'hu.dwim.excosy::interpret-primitive-application/write-byte-to-standard-output :arguments (list (make-instance 'hu.dwim.excosy::primitive-application/ast :interpreter-function 'hu.dwim.excosy::interpret-primitive-application/add/native-integer+native-integer :arguments (list read-byte-ast-1 read-byte-ast-2)))))) (assemble-excosy machine (compile-excosy machine ast)))) ;; NOTE: for reference (def function greatest-common-divisor (left right) (if (< left right) (greatest-common-divisor right left) (if (= right 0) left (greatest-common-divisor right (mod left right)))))