Skip to content

Instantly share code, notes, and snippets.

@lkuper
Created January 5, 2014 07:10
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save lkuper/8265340 to your computer and use it in GitHub Desktop.
Save lkuper/8265340 to your computer and use it in GitHub Desktop.
(load "mkprelude.scm")
(define peanoo
(lambda (n out)
(conde
[(== n (build-num 0)) (== '(O) out)]
[(fresh (n1 res)
(-o n (build-num 1) n1)
(conso 'S res out)
(peanoo n1 res))])))
(test "peanoo-1"
(run 1 (q) (peanoo (build-num 0) q))
'((O)))
(test "peanoo-2"
(run 1 (q) (peanoo (build-num 3) q))
'((S S S O)))
(test "peanoo-3"
(run 1 (q) (peanoo q '(O)))
'(()))
(test "peanoo-4"
(run 1 (q) (peanoo q '(S S S O)))
'((1 1)))
(define-syntax test
(syntax-rules ()
((_ title tested-expression expected-result)
(let* ((expected expected-result)
(produced tested-expression))
(if (equal? expected produced)
(printf "~s works!\n" title)
(error
'test
"Failed ~s: ~a\nExpected: ~a\nComputed: ~a"
title 'tested-expression expected produced))))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment