Permalink
Browse files

Replace "cmethod" and "imethod" with "+" and "-".

I have come to prefer these because they are more consistent with Objective-C.
I would like to deprecate/eliminate cmethod/imethod.
  • Loading branch information...
1 parent 237bf3b commit 045f219bfa36fd15f8914a42925f394c36f5819f Tim Burks committed Oct 19, 2010
View
50 test/test_blockargs.nu
@@ -6,31 +6,31 @@
(class TestBlockArgs is NuTestCase
- (imethod (id) testSimpleArgs is
- (function make-list (a b c)
- (list a b c))
- (assert_equal '(1 2 3) (make-list 1 2 3)))
+ (- (id) testSimpleArgs is
+ (function make-list (a b c)
+ (list a b c))
+ (assert_equal '(1 2 3) (make-list 1 2 3)))
- (imethod (id) testRestArgs is
- (function make-list (a b *rest)
- (append (list a b) *rest))
- (assert_equal '(1 2 3) (make-list 1 2 3))
- (assert_equal '(1 2 3 4 5) (make-list 1 2 3 4 5)))
+ (- (id) testRestArgs is
+ (function make-list (a b *rest)
+ (append (list a b) *rest))
+ (assert_equal '(1 2 3) (make-list 1 2 3))
+ (assert_equal '(1 2 3 4 5) (make-list 1 2 3 4 5)))
- (imethod (id) testOverrideImplicitArgs1 is
- (function make-list (*args)
- (*args))
- (assert_equal '(1 2 3) (make-list 1 2 3))
- (assert_equal '() (make-list)))
+ (- (id) testOverrideImplicitArgs1 is
+ (function make-list (*args)
+ (*args))
+ (assert_equal '(1 2 3) (make-list 1 2 3))
+ (assert_equal '() (make-list)))
- (imethod (id) testOverrideImplicitArgs2 is
- (function make-list (a b *args)
- (list a b *args))
- (assert_equal '(1 2 ()) (make-list 1 2))
- (assert_equal '(1 2 (3)) (make-list 1 2 3)))
-
- (imethod (id) testBlock is
- (assert_equal '(1 2) ((do (a b) (list a b)) 1 2))
- (assert_equal '(1 2) ((do (a b *args) (list a b)) 1 2 3 4))
- (assert_equal '(3 4) ((do (a b *args) (*args)) 1 2 3 4))
- (assert_equal '(1 (3 4)) ((do (a b *args) (list a *args)) 1 2 3 4))))
+ (- (id) testOverrideImplicitArgs2 is
+ (function make-list (a b *args)
+ (list a b *args))
+ (assert_equal '(1 2 ()) (make-list 1 2))
+ (assert_equal '(1 2 (3)) (make-list 1 2 3)))
+
+ (- (id) testBlock is
+ (assert_equal '(1 2) ((do (a b) (list a b)) 1 2))
+ (assert_equal '(1 2) ((do (a b *args) (list a b)) 1 2 3 4))
+ (assert_equal '(3 4) ((do (a b *args) (*args)) 1 2 3 4))
+ (assert_equal '(1 (3 4)) ((do (a b *args) (list a *args)) 1 2 3 4))))
View
26 test/test_bridge.nu
@@ -5,18 +5,18 @@
(class TestBridge is NuTestCase
(if (eq (uname) "Darwin")
- (imethod (id) testConstants is
- (set floatTypeSignature (if (eq (Nu sizeOfPointer) 8) (then "d") (else "f")))
- (assert_equal 0 (NuBridgedConstant constantWithName:"NSBlack" signature:floatTypeSignature))
- (assert_equal 1 (NuBridgedConstant constantWithName:"NSWhite" signature:floatTypeSignature))
- (assert_equal '(0 0 0 0) (NuBridgedConstant constantWithName:"NSZeroRect" signature:"{_NSRect}"))
- (assert_equal (NSApplication sharedApplication) (NuBridgedConstant constantWithName:"NSApp" signature:"@"))))
+ (- (id) testConstants is
+ (set floatTypeSignature (if (eq (Nu sizeOfPointer) 8) (then "d") (else "f")))
+ (assert_equal 0 (NuBridgedConstant constantWithName:"NSBlack" signature:floatTypeSignature))
+ (assert_equal 1 (NuBridgedConstant constantWithName:"NSWhite" signature:floatTypeSignature))
+ (assert_equal '(0 0 0 0) (NuBridgedConstant constantWithName:"NSZeroRect" signature:"{_NSRect}"))
+ (assert_equal (NSApplication sharedApplication) (NuBridgedConstant constantWithName:"NSApp" signature:"@"))))
- (imethod (id) testFunctions is
- (set strcmp (NuBridgedFunction functionWithName:"strcmp" signature:"i**"))
- (assert_less_than 0 (strcmp "a" "b"))
- (assert_equal 0 (strcmp "b" "b"))
- (assert_greater_than 0 (strcmp "c" "b"))
- (set pow (NuBridgedFunction functionWithName:"pow" signature:"ddd"))
- (assert_equal 8 (pow 2 3))))
+ (- (id) testFunctions is
+ (set strcmp (NuBridgedFunction functionWithName:"strcmp" signature:"i**"))
+ (assert_less_than 0 (strcmp "a" "b"))
+ (assert_equal 0 (strcmp "b" "b"))
+ (assert_greater_than 0 (strcmp "c" "b"))
+ (set pow (NuBridgedFunction functionWithName:"pow" signature:"ddd"))
+ (assert_equal 8 (pow 2 3))))
View
12 test/test_bridgesupport.nu
@@ -8,12 +8,12 @@
(class TestBridgeSupport is NuTestCase
- (imethod (id) testConstants is
- (assert_equal "NSFileBusy" NSFileBusy))
+ (- (id) testConstants is
+ (assert_equal "NSFileBusy" NSFileBusy))
- (imethod (id) testEnums is
- (assert_equal 4 NSGreaterThanComparison))
+ (- (id) testEnums is
+ (assert_equal 4 NSGreaterThanComparison))
(unless ((NSGarbageCollector defaultCollector) isEnabled)
- (imethod (id) testFunctions is
- (assert_equal 2 (NSMinY '(1 2 3 4)))))))
+ (- (id) testFunctions is
+ (assert_equal 2 (NSMinY '(1 2 3 4)))))))
View
80 test/test_characters.nu
@@ -5,51 +5,51 @@
(class TestCharacters is NuTestCase
- (imethod (id) testRegularCharacters is
- (set a 'a')
- (set Z 'Z')
- (set LPAREN '(')
- (set RPAREN ')')
- (set SEMICOLON ';')
- (set HASH '#')
- (set golden "aZ();#")
- (assert_equal (golden characterAtIndex:0) a)
- (assert_equal (golden characterAtIndex:1) Z)
- (assert_equal (golden characterAtIndex:2) LPAREN)
- (assert_equal (golden characterAtIndex:3) RPAREN)
- (assert_equal (golden characterAtIndex:4) SEMICOLON)
- (assert_equal (golden characterAtIndex:5) HASH))
+ (- (id) testRegularCharacters is
+ (set a 'a')
+ (set Z 'Z')
+ (set LPAREN '(')
+ (set RPAREN ')')
+ (set SEMICOLON ';')
+ (set HASH '#')
+ (set golden "aZ();#")
+ (assert_equal (golden characterAtIndex:0) a)
+ (assert_equal (golden characterAtIndex:1) Z)
+ (assert_equal (golden characterAtIndex:2) LPAREN)
+ (assert_equal (golden characterAtIndex:3) RPAREN)
+ (assert_equal (golden characterAtIndex:4) SEMICOLON)
+ (assert_equal (golden characterAtIndex:5) HASH))
- (imethod (id) testEscapedCharacters is
- (assert_equal 10 '\n')
- (assert_equal 13 '\r')
- (assert_equal 12 '\f')
- (assert_equal 8 '\b')
- (assert_equal 7 '\a')
- (assert_equal 27 '\e')
- (assert_equal 32 '\s'))
+ (- (id) testEscapedCharacters is
+ (assert_equal 10 '\n')
+ (assert_equal 13 '\r')
+ (assert_equal 12 '\f')
+ (assert_equal 8 '\b')
+ (assert_equal 7 '\a')
+ (assert_equal 27 '\e')
+ (assert_equal 32 '\s'))
- (imethod (id) testOctalEscapedCharacters is
- (if (eq (uname) "Darwin") ;; requires UTF-8
- (assert_equal 0 '\000'))
- (assert_equal 1 '\001')
- (assert_equal 255 '\377'))
+ (- (id) testOctalEscapedCharacters is
+ (if (eq (uname) "Darwin") ;; requires UTF-8
+ (assert_equal 0 '\000'))
+ (assert_equal 1 '\001')
+ (assert_equal 255 '\377'))
- (imethod (id) testHexEscapedCharacters is
- (if (eq (uname) "Darwin") ;; requires UTF-8
- (assert_equal 0 '\x00'))
- (assert_equal 1 '\x01')
- (assert_equal 255 '\xfF'))
+ (- (id) testHexEscapedCharacters is
+ (if (eq (uname) "Darwin") ;; requires UTF-8
+ (assert_equal 0 '\x00'))
+ (assert_equal 1 '\x01')
+ (assert_equal 255 '\xfF'))
(if (eq (uname) "Darwin") ;; requires UTF-8
- (imethod (id) testUnicodeEscapedCharacters is
- (assert_equal 0 '\u0000')
- (assert_equal 1 '\u0001')
- (assert_equal 65535 '\uFfFf')
- (assert_equal 255 '\u00ff')))
+ (- (id) testUnicodeEscapedCharacters is
+ (assert_equal 0 '\u0000')
+ (assert_equal 1 '\u0001')
+ (assert_equal 65535 '\uFfFf')
+ (assert_equal 255 '\u00ff')))
- (imethod (id) testFourCharacterIntegers is
- (assert_equal 1886604404 'psLt')
- (assert_equal 1886601524 'psA4')))
+ (- (id) testFourCharacterIntegers is
+ (assert_equal 1886604404 'psLt')
+ (assert_equal 1886601524 'psA4')))
View
52 test/test_closures.nu
@@ -9,30 +9,30 @@
(class TestClosures is NuTestCase
- (imethod (id) testAccumulator is
- ;; The accumulator function from Paul Graham's
- ;; "Revenge of the Nerds", http://www.paulgraham.com/icad.html
- (function make-accumulator (n)
- (do (i) (set n (+ n i))))
- (set accumulator (make-accumulator 0))
- (assert_equal 1 (accumulator 1))
- (assert_equal 3 (accumulator 2))
- (assert_equal 6 (accumulator 3))
- (set accumulator (make-accumulator 5))
- (assert_equal 6 (accumulator 1))
- (assert_equal 8 (accumulator 2))
- (assert_equal 11 (accumulator 3)))
+ (- (id) testAccumulator is
+ ;; The accumulator function from Paul Graham's
+ ;; "Revenge of the Nerds", http://www.paulgraham.com/icad.html
+ (function make-accumulator (n)
+ (do (i) (set n (+ n i))))
+ (set accumulator (make-accumulator 0))
+ (assert_equal 1 (accumulator 1))
+ (assert_equal 3 (accumulator 2))
+ (assert_equal 6 (accumulator 3))
+ (set accumulator (make-accumulator 5))
+ (assert_equal 6 (accumulator 1))
+ (assert_equal 8 (accumulator 2))
+ (assert_equal 11 (accumulator 3)))
- (imethod (id) testScoping is
- (set x 0)
- ;; Here we redefine x inside the let context, so
- ;; assignments to x in the block do not affect the outer x
- (10 times: (do (i) (let ((x x)) (set x (+ x 1)))))
- (assert_equal 0 x)
- ;; Here we refer to the outer binding of x, so
- ;; assignments to x in the block do affect the outer x
- (10 times: (do (i) (set x (+ x 1)) (set y x)))
- (assert_equal 10 x)
- (assert_equal 10 ((context) objectForKey:'x))
- ;; but assignments to y are invisible in the outer context
- (assert_equal nil ((context) objectForKey:'y))))
+ (- (id) testScoping is
+ (set x 0)
+ ;; Here we redefine x inside the let context, so
+ ;; assignments to x in the block do not affect the outer x
+ (10 times: (do (i) (let ((x x)) (set x (+ x 1)))))
+ (assert_equal 0 x)
+ ;; Here we refer to the outer binding of x, so
+ ;; assignments to x in the block do affect the outer x
+ (10 times: (do (i) (set x (+ x 1)) (set y x)))
+ (assert_equal 10 x)
+ (assert_equal 10 ((context) objectForKey:'x))
+ ;; but assignments to y are invisible in the outer context
+ (assert_equal nil ((context) objectForKey:'y))))
View
444 test/test_control.nu
@@ -5,239 +5,239 @@
(class TestControl is NuTestCase
- (imethod (id) testIf is
- (set x 0)
- (if (== x 0)
- (then (set y 0) (set y (+ y 1)))
- (else (if (== x 1)
- (then (set y 10) (set y (+ y 1)))
- (else (set y 100) (set y (+ y 1)))
- (set y (+ y 1))))
- (set y (+ y 1)))
- (assert_equal 2 y)
-
- (set x 1)
- (if (== x 0)
- (then (set y 0) (set y (+ y 1)))
- (else (if (== x 1)
- (then (set y 10) (set y (+ y 1)))
- (else (set y 100) (set y (+ y 1)))
- (set y (+ y 1))))
- (set y (+ y 1)))
- (assert_equal 12 y)
-
- (set x 2)
- (if (== x 0)
- (then (set y 0) (set y (+ y 1)))
- (else (if (== x 1)
- (then (set y 10) (set y (+ y 1)))
- (else (set y 100) (set y (+ y 1)))
- (set y (+ y 1))))
- (set y (+ y 1)))
- (assert_equal 101 y))
+ (- (id) testIf is
+ (set x 0)
+ (if (== x 0)
+ (then (set y 0) (set y (+ y 1)))
+ (else (if (== x 1)
+ (then (set y 10) (set y (+ y 1)))
+ (else (set y 100) (set y (+ y 1)))
+ (set y (+ y 1))))
+ (set y (+ y 1)))
+ (assert_equal 2 y)
+
+ (set x 1)
+ (if (== x 0)
+ (then (set y 0) (set y (+ y 1)))
+ (else (if (== x 1)
+ (then (set y 10) (set y (+ y 1)))
+ (else (set y 100) (set y (+ y 1)))
+ (set y (+ y 1))))
+ (set y (+ y 1)))
+ (assert_equal 12 y)
+
+ (set x 2)
+ (if (== x 0)
+ (then (set y 0) (set y (+ y 1)))
+ (else (if (== x 1)
+ (then (set y 10) (set y (+ y 1)))
+ (else (set y 100) (set y (+ y 1)))
+ (set y (+ y 1))))
+ (set y (+ y 1)))
+ (assert_equal 101 y))
- (imethod (id) testUnless is
- (set x 0)
- (unless (!= x 0)
- (then (set y 0) (set y (+ y 1)))
- (else (unless (!= x 1)
- (then (set y 10) (set y (+ y 1)))
- (else (set y 100) (set y (+ y 1)))
- (set y (+ y 1))))
- (set y (+ y 1)))
- (assert_equal 2 y)
-
- (set x 1)
- (unless (!= x 0)
- (then (set y 0) (set y (+ y 1)))
- (else (unless (!= x 1)
- (then (set y 10) (set y (+ y 1)))
- (else (set y 100) (set y (+ y 1)))
- (set y (+ y 1))))
- (set y (+ y 1)))
- (assert_equal 12 y)
-
- (set x 2)
- (unless (!= x 0)
- (then (set y 0) (set y (+ y 1)))
- (else (unless (!= x 1)
- (then (set y 10) (set y (+ y 1)))
- (else (set y 100) (set y (+ y 1)))
- (set y (+ y 1))))
- (set y (+ y 1)))
- (assert_equal 101 y))
+ (- (id) testUnless is
+ (set x 0)
+ (unless (!= x 0)
+ (then (set y 0) (set y (+ y 1)))
+ (else (unless (!= x 1)
+ (then (set y 10) (set y (+ y 1)))
+ (else (set y 100) (set y (+ y 1)))
+ (set y (+ y 1))))
+ (set y (+ y 1)))
+ (assert_equal 2 y)
+
+ (set x 1)
+ (unless (!= x 0)
+ (then (set y 0) (set y (+ y 1)))
+ (else (unless (!= x 1)
+ (then (set y 10) (set y (+ y 1)))
+ (else (set y 100) (set y (+ y 1)))
+ (set y (+ y 1))))
+ (set y (+ y 1)))
+ (assert_equal 12 y)
+
+ (set x 2)
+ (unless (!= x 0)
+ (then (set y 0) (set y (+ y 1)))
+ (else (unless (!= x 1)
+ (then (set y 10) (set y (+ y 1)))
+ (else (set y 100) (set y (+ y 1)))
+ (set y (+ y 1))))
+ (set y (+ y 1)))
+ (assert_equal 101 y))
- (imethod (id) testWhile is
- (set x 10)
- (set y 0)
- (while x
- (set y (+ y x))
- (set x (- x 1)))
- (assert_equal 55 y))
+ (- (id) testWhile is
+ (set x 10)
+ (set y 0)
+ (while x
+ (set y (+ y x))
+ (set x (- x 1)))
+ (assert_equal 55 y))
- (imethod (id) testUntil is
- (set x 10)
- (set y 0)
- (until (== x 0)
- (set y (+ y x))
- (set x (- x 1)))
- (assert_equal 55 y))
+ (- (id) testUntil is
+ (set x 10)
+ (set y 0)
+ (until (== x 0)
+ (set y (+ y x))
+ (set x (- x 1)))
+ (assert_equal 55 y))
- (imethod (id) testWhileBreak is
- (set $count 0)
- (set x 10)
- (while (!= x 0)
- (set x (- x 1))
- (set y 10)
- (while (!= y 0)
- (set y (- y 1))
- (set $count (+ $count 1))
- (if (eq y 5) (break))))
- (assert_equal 50 $count))
+ (- (id) testWhileBreak is
+ (set $count 0)
+ (set x 10)
+ (while (!= x 0)
+ (set x (- x 1))
+ (set y 10)
+ (while (!= y 0)
+ (set y (- y 1))
+ (set $count (+ $count 1))
+ (if (eq y 5) (break))))
+ (assert_equal 50 $count))
- (imethod (id) testWhileContinue is
- (set $count 0)
- (set x 10)
- (while (!= x 0)
- (set x (- x 1))
- (set y 10)
- (while (!= y 0)
- (set y (- y 1))
- (if (>= y 5) (continue))
- (set $count (+ $count 1))))
- (assert_equal 50 $count))
+ (- (id) testWhileContinue is
+ (set $count 0)
+ (set x 10)
+ (while (!= x 0)
+ (set x (- x 1))
+ (set y 10)
+ (while (!= y 0)
+ (set y (- y 1))
+ (if (>= y 5) (continue))
+ (set $count (+ $count 1))))
+ (assert_equal 50 $count))
- (imethod (id) testUntilBreak is
- (set count 0)
- (set x 10)
- (until (== x 0)
- (set x (- x 1))
- (set y 10)
- (until (== y 0)
- (set y (- y 1))
- (set count (+ count 1))
- (if (eq y 5) (break))))
- (assert_equal 50 count))
+ (- (id) testUntilBreak is
+ (set count 0)
+ (set x 10)
+ (until (== x 0)
+ (set x (- x 1))
+ (set y 10)
+ (until (== y 0)
+ (set y (- y 1))
+ (set count (+ count 1))
+ (if (eq y 5) (break))))
+ (assert_equal 50 count))
- (imethod (id) testUntilContinue is
- (set count 0)
- (set x 10)
- (until (== x 0)
- (set x (- x 1))
- (set y 10)
- (until (== y 0)
- (set y (- y 1))
- (if (>= y 5) (continue))
- (set count (+ count 1))))
- (assert_equal 50 count))
+ (- (id) testUntilContinue is
+ (set count 0)
+ (set x 10)
+ (until (== x 0)
+ (set x (- x 1))
+ (set y 10)
+ (until (== y 0)
+ (set y (- y 1))
+ (if (>= y 5) (continue))
+ (set count (+ count 1))))
+ (assert_equal 50 count))
- (imethod (id) testLoopMacro is
- ;; here is a simple macro defining an unending loop
- (macro-0 loop (eval (append '(while t) margs)))
- ;; here's a macro that decrements a named value
- (macro-0 decrement (set (unquote (margs car)) (- (unquote (margs car)) 1)))
- ;; here's a macro that increments a named value
- (macro-0 increment (set (unquote (margs car)) (+ (unquote (margs car)) 1)))
- ;; run the loop, breaking out after 5 iterations
- (set count 0)
- (set x 10)
- (loop
- (decrement x)
- (increment count)
- (if (eq x 5) (break)))
- (assert_equal 5 count)
- ;; run the loop, breaking out after 10 iterations
- ;; but only counting until the loop counter (x) drops below 5
- (set count 0)
- (set x 10)
- (loop
- (decrement x)
- (if (eq x 0) (break))
- (if (< x 5) (continue))
- (increment count))
- (assert_equal 5 count))
+ (- (id) testLoopMacro is
+ ;; here is a simple macro defining an unending loop
+ (macro-0 loop (eval (append '(while t) margs)))
+ ;; here's a macro that decrements a named value
+ (macro-0 decrement (set (unquote (margs car)) (- (unquote (margs car)) 1)))
+ ;; here's a macro that increments a named value
+ (macro-0 increment (set (unquote (margs car)) (+ (unquote (margs car)) 1)))
+ ;; run the loop, breaking out after 5 iterations
+ (set count 0)
+ (set x 10)
+ (loop
+ (decrement x)
+ (increment count)
+ (if (eq x 5) (break)))
+ (assert_equal 5 count)
+ ;; run the loop, breaking out after 10 iterations
+ ;; but only counting until the loop counter (x) drops below 5
+ (set count 0)
+ (set x 10)
+ (loop
+ (decrement x)
+ (if (eq x 0) (break))
+ (if (< x 5) (continue))
+ (increment count))
+ (assert_equal 5 count))
- (imethod (id) testFor is
- (set x 0)
- (for ((set i 1) (< i 10) (set i (+ i 1)))
- (set x (+ x i)))
- (assert_equal 45 x))
+ (- (id) testFor is
+ (set x 0)
+ (for ((set i 1) (< i 10) (set i (+ i 1)))
+ (set x (+ x i)))
+ (assert_equal 45 x))
- (imethod (id) testForBreak is
- (set x 0)
- (for ((set i 1) (< i 10) (set i (+ i 1)))
- (if (== i 6) (break))
- (set x (+ x i)))
- (assert_equal 15 x))
+ (- (id) testForBreak is
+ (set x 0)
+ (for ((set i 1) (< i 10) (set i (+ i 1)))
+ (if (== i 6) (break))
+ (set x (+ x i)))
+ (assert_equal 15 x))
- (imethod (id) testForContinue is
- (set x 0)
- (for ((set i 1) (< i 10) (set i (+ i 1)))
- (if (== i 6) (continue))
- (set x (+ x i)))
- (assert_equal 39 x))
+ (- (id) testForContinue is
+ (set x 0)
+ (for ((set i 1) (< i 10) (set i (+ i 1)))
+ (if (== i 6) (continue))
+ (set x (+ x i)))
+ (assert_equal 39 x))
- (imethod (id) testCond is
- (set x 0)
- (assert_equal 1
- (cond
- ((== x 0) (set y 0) (set y (+ y 1)))
- ((== x 1) (set y 10) (set y (+ y 1)))
- (else (set y 100) (set y (+ y 1)))))
-
- (set x 1)
- (assert_equal 11
- (cond
- ((== x 0) (set y 0) (set y (+ y 1)))
- ((== x 1) (set y 10) (set y (+ y 1)))
- (else (set y 100) (set y (+ y 1)))))
-
- (set x 2)
- (assert_equal 101
- (cond
- ((== x 0) (set y 0) (set y (+ y 1)))
- ((== x 1) (set y 10) (set y (+ y 1)))
- (else (set y 100) (set y (+ y 1)))))
-
- ;; test fallthrough
- (assert_equal 1
- (cond (1)
- (else 2)))
-
- (assert_equal 1
- (cond (0)
- (1)
- (else 2)))
-
- (assert_equal 2
- (cond (0)
- (0)
- (else 2)))
-
- (assert_equal 2
- (cond (0)
- (0)
- (2))))
+ (- (id) testCond is
+ (set x 0)
+ (assert_equal 1
+ (cond
+ ((== x 0) (set y 0) (set y (+ y 1)))
+ ((== x 1) (set y 10) (set y (+ y 1)))
+ (else (set y 100) (set y (+ y 1)))))
+
+ (set x 1)
+ (assert_equal 11
+ (cond
+ ((== x 0) (set y 0) (set y (+ y 1)))
+ ((== x 1) (set y 10) (set y (+ y 1)))
+ (else (set y 100) (set y (+ y 1)))))
+
+ (set x 2)
+ (assert_equal 101
+ (cond
+ ((== x 0) (set y 0) (set y (+ y 1)))
+ ((== x 1) (set y 10) (set y (+ y 1)))
+ (else (set y 100) (set y (+ y 1)))))
+
+ ;; test fallthrough
+ (assert_equal 1
+ (cond (1)
+ (else 2)))
+
+ (assert_equal 1
+ (cond (0)
+ (1)
+ (else 2)))
+
+ (assert_equal 2
+ (cond (0)
+ (0)
+ (else 2)))
+
+ (assert_equal 2
+ (cond (0)
+ (0)
+ (2))))
- (imethod (id) testCase is
- (set x 0)
- (assert_equal 1
- (case x
- (0 (set y 0) (set y (+ y 1)))
- (1 (set y 10) (set y (+ y 1)))
- (else (set y 100) (set y (+ y 1)))))
-
- (set x 1)
- (assert_equal 11
- (case x
- (0 (set y 0) (set y (+ y 1)))
- (1 (set y 10) (set y (+ y 1)))
- (else (set y 100) (set y (+ y 1)))))
-
- (set x 2)
- (assert_equal 101
- (case x
- (0 (set y 0) (set y (+ y 1)))
- (1 (set y 10) (set y (+ y 1)))
- (else (set y 100) (set y (+ y 1)))))))
+ (- (id) testCase is
+ (set x 0)
+ (assert_equal 1
+ (case x
+ (0 (set y 0) (set y (+ y 1)))
+ (1 (set y 10) (set y (+ y 1)))
+ (else (set y 100) (set y (+ y 1)))))
+
+ (set x 1)
+ (assert_equal 11
+ (case x
+ (0 (set y 0) (set y (+ y 1)))
+ (1 (set y 10) (set y (+ y 1)))
+ (else (set y 100) (set y (+ y 1)))))
+
+ (set x 2)
+ (assert_equal 101
+ (case x
+ (0 (set y 0) (set y (+ y 1)))
+ (1 (set y 10) (set y (+ y 1)))
+ (else (set y 100) (set y (+ y 1)))))))
View
126 test/test_dictionary.nu
@@ -5,72 +5,72 @@
(class TestDictionary is NuTestCase
- (imethod (id) testSet is
- (set d (NSMutableDictionary dictionary))
- (d set:(one:1
- "two" 2
- three:"three"))
- (assert_equal 3 (d count))
- (assert_equal 2 (d valueForKey:"two"))
- (assert_equal "three" (d valueForKey:"three")))
+ (- (id) testSet is
+ (set d (NSMutableDictionary dictionary))
+ (d set:(one:1
+ "two" 2
+ three:"three"))
+ (assert_equal 3 (d count))
+ (assert_equal 2 (d valueForKey:"two"))
+ (assert_equal "three" (d valueForKey:"three")))
- (imethod (id) testCreate is
- (set d (NSMutableDictionary dictionaryWithList:(one:1
- "two" 2
- three:"three")))
- (assert_equal 3 (d count))
- (assert_equal 2 (d valueForKey:"two"))
- (assert_equal "three" (d valueForKey:"three")))
+ (- (id) testCreate is
+ (set d (NSMutableDictionary dictionaryWithList:(one:1
+ "two" 2
+ three:"three")))
+ (assert_equal 3 (d count))
+ (assert_equal 2 (d valueForKey:"two"))
+ (assert_equal "three" (d valueForKey:"three")))
- (imethod (id) testAutomaticAccessor is
- (set d (dict "one" 1 two:2))
- (assert_equal 1 (d "one"))
- (assert_equal 2 (d "two")))
+ (- (id) testAutomaticAccessor is
+ (set d (dict "one" 1 two:2))
+ (assert_equal 1 (d "one"))
+ (assert_equal 2 (d "two")))
- (imethod (id) testEach is
- (set d (dict one:1 two:2 three:3 four:4 five:5 six:6))
- ;; test each: through everything
- (set count 0)
- (d each:
- (do (k v)
- (assert_equal (d objectForKey:k) v)
- (set count (+ count 1))))
- (assert_equal (d count) count)
- ;; test each: with break
- (set count 0)
- (d each:
- (do (k v)
- (if (eq count 3) (break))
- (set count (+ count 1))))
- (assert_equal 3 count)
- ;; test each: with continue
- (set count 0)
- (d each:
- (do (k v)
- (if (eq v 3) (continue))
- (set count (+ count 1))))
- (assert_equal (- (d count) 1) count))
+ (- (id) testEach is
+ (set d (dict one:1 two:2 three:3 four:4 five:5 six:6))
+ ;; test each: through everything
+ (set count 0)
+ (d each:
+ (do (k v)
+ (assert_equal (d objectForKey:k) v)
+ (set count (+ count 1))))
+ (assert_equal (d count) count)
+ ;; test each: with break
+ (set count 0)
+ (d each:
+ (do (k v)
+ (if (eq count 3) (break))
+ (set count (+ count 1))))
+ (assert_equal 3 count)
+ ;; test each: with continue
+ (set count 0)
+ (d each:
+ (do (k v)
+ (if (eq v 3) (continue))
+ (set count (+ count 1))))
+ (assert_equal (- (d count) 1) count))
- (imethod (id) testLookupWithDefault is
- (set d (dict "one" 1 two:2))
- (assert_equal 1 (d objectForKey:"one" withDefault:3))
- (assert_equal 3 (d objectForKey:"three" withDefault:3)))
+ (- (id) testLookupWithDefault is
+ (set d (dict "one" 1 two:2))
+ (assert_equal 1 (d objectForKey:"one" withDefault:3))
+ (assert_equal 3 (d objectForKey:"three" withDefault:3)))
- (imethod (id) testShorthand is
- (set d (dict a:12 b:23 c:34))
- (assert_equal 12 (d "a"))
- (set x "a")
- (assert_equal 12 (d x))
- (assert_equal 12 (d a:))
- (d a:78 d:89 e:90)
- (assert_equal 5 (d count))
- (assert_equal 78 (d a:))
- (assert_equal 89 (d d:))
- (assert_equal 90 (d e:))
- (assert_equal 11 (d a:11 b:22 a:))
- (assert_equal 22 (d b:))
- ;; make sure that we properly evaluate key and value arguments
- (d (+ "a" "a") (+ "b" "b") (+ "c" "c") (+ "d" "d"))
- (assert_equal "bb" (d (+ "a" "a")))
- (assert_equal "dd" (d (+ "c" "" "c")))))
+ (- (id) testShorthand is
+ (set d (dict a:12 b:23 c:34))
+ (assert_equal 12 (d "a"))
+ (set x "a")
+ (assert_equal 12 (d x))
+ (assert_equal 12 (d a:))
+ (d a:78 d:89 e:90)
+ (assert_equal 5 (d count))
+ (assert_equal 78 (d a:))
+ (assert_equal 89 (d d:))
+ (assert_equal 90 (d e:))
+ (assert_equal 11 (d a:11 b:22 a:))
+ (assert_equal 22 (d b:))
+ ;; make sure that we properly evaluate key and value arguments
+ (d (+ "a" "a") (+ "b" "b") (+ "c" "c") (+ "d" "d"))
+ (assert_equal "bb" (d (+ "a" "a")))
+ (assert_equal "dd" (d (+ "c" "" "c")))))
View
128 test/test_errors.nu
@@ -4,86 +4,86 @@
;; Copyright (c) 2007 Tim Burks, Neon Design Technology, Inc.
;; use these functions to call class construction operators outside of any class scope.
-(function misplaced-imethod () (imethod foo is nil))
-(function misplaced-cmethod () (cmethod foo is nil))
+(function misplaced-instance-method () (imethod foo is nil))
+(function misplaced-class-method () (cmethod foo is nil))
(function misplaced-ivar () (ivar (id) foo))
(function misplaced-ivars () (ivars))
(class TestErrors is NuTestCase
- (imethod (id) testMisplacedImethod is
- (try
- (misplaced-imethod)
- (catch (exception) (set myException exception)))
- (assert_equal "NuMisplacedDeclaration" (myException name)))
+ (- (id) testMisplacedInstanceMethod is
+ (try
+ (misplaced-instance-method)
+ (catch (exception) (set myException exception)))
+ (assert_equal "NuMisplacedDeclaration" (myException name)))
- (imethod (id) testMisplacedCmethod is
- (try
- (misplaced-cmethod)
- (catch (exception) (set myException exception)))
- (assert_equal "NuMisplacedDeclaration" (myException name)))
+ (- (id) testMisplacedClassMethod is
+ (try
+ (misplaced-class-method)
+ (catch (exception) (set myException exception)))
+ (assert_equal "NuMisplacedDeclaration" (myException name)))
- (imethod (id) testMisplacedIvar is
- (try
- (misplaced-ivar)
- (catch (exception) (set myException exception)))
- (assert_equal "NuMisplacedDeclaration" (myException name)))
+ (- (id) testMisplacedIvar is
+ (try
+ (misplaced-ivar)
+ (catch (exception) (set myException exception)))
+ (assert_equal "NuMisplacedDeclaration" (myException name)))
- (imethod (id) testMisplacedIvars is
- (try
- (misplaced-ivars)
- (catch (exception) (set myException exception)))
- (assert_equal "NuMisplacedDeclaration" (myException name)))
+ (- (id) testMisplacedIvars is
+ (try
+ (misplaced-ivars)
+ (catch (exception) (set myException exception)))
+ (assert_equal "NuMisplacedDeclaration" (myException name)))
- (imethod (id) testUndefinedClass is
- (try
- (class Undefined)
- (catch (exception) (set myException exception)))
- (assert_equal "NuUndefinedClass" (myException name)))
+ (- (id) testUndefinedClass is
+ (try
+ (class Undefined)
+ (catch (exception) (set myException exception)))
+ (assert_equal "NuUndefinedClass" (myException name)))
- (imethod (id) testUndefinedSuperClass is
- (try
- (class Undefined is AlsoUndefined)
- (catch (exception) (set myException exception)))
- (assert_equal "NuUndefinedSuperclass" (myException name)))
+ (- (id) testUndefinedSuperClass is
+ (try
+ (class Undefined is AlsoUndefined)
+ (catch (exception) (set myException exception)))
+ (assert_equal "NuUndefinedSuperclass" (myException name)))
- (imethod (id) testParseError is
- (try
- (parse "(1 + ))") ;; parse error
- (catch (exception) (set myException exception)))
- (assert_equal "NuParseError" (myException name)))
+ (- (id) testParseError is
+ (try
+ (parse "(1 + ))") ;; parse error
+ (catch (exception) (set myException exception)))
+ (assert_equal "NuParseError" (myException name)))
- (imethod (id) testUndefinedSymbol is
- (try
- foo ;; undefined symbol
- (catch (exception) (set myException exception)))
- (assert_equal "NuUndefinedSymbol" (myException name)))
+ (- (id) testUndefinedSymbol is
+ (try
+ foo ;; undefined symbol
+ (catch (exception) (set myException exception)))
+ (assert_equal "NuUndefinedSymbol" (myException name)))
- (imethod (id) testCarOnAtom is
- (try
- (car 'foo) ;; can't call car on atoms
- (catch (exception) (set myException exception)))
- (assert_equal "NuCarCalledOnAtom" (myException name)))
+ (- (id) testCarOnAtom is
+ (try
+ (car 'foo) ;; can't call car on atoms
+ (catch (exception) (set myException exception)))
+ (assert_equal "NuCarCalledOnAtom" (myException name)))
- (imethod (id) testCdrOnAtom is
- (try
- (cdr 'foo) ;; can't call cdr on atoms
- (catch (exception) (set myException exception)))
- (assert_equal "NuCdrCalledOnAtom" (myException name)))
+ (- (id) testCdrOnAtom is
+ (try
+ (cdr 'foo) ;; can't call cdr on atoms
+ (catch (exception) (set myException exception)))
+ (assert_equal "NuCdrCalledOnAtom" (myException name)))
- (imethod (id) testIncorrectNumberOfBlockArguments is
- (try
- ((do (x y) (+ x y)) 1 2 3) ;; incorrect number of block arguments
- (catch (exception) (set myException exception)))
- (assert_equal "NuIncorrectNumberOfArguments" (myException name)))
+ (- (id) testIncorrectNumberOfBlockArguments is
+ (try
+ ((do (x y) (+ x y)) 1 2 3) ;; incorrect number of block arguments
+ (catch (exception) (set myException exception)))
+ (assert_equal "NuIncorrectNumberOfArguments" (myException name)))
- (imethod (id) testNoInstanceVariable is
- (try
- (class TestClass is NSObject
- (imethod (id) accessMissingIvar is @foo))
- (((TestClass alloc) init) accessMissingIvar)
- (catch (exception) (set myException exception)))
- (assert_equal "NuNoInstanceVariable" (myException name))))
+ (- (id) testNoInstanceVariable is
+ (try
+ (class TestClass is NSObject
+ (- (id) accessMissingIvar is @foo))
+ (((TestClass alloc) init) accessMissingIvar)
+ (catch (exception) (set myException exception)))
+ (assert_equal "NuNoInstanceVariable" (myException name))))
View
124 test/test_exceptions.nu
@@ -5,73 +5,73 @@
(class TestExceptions is NuTestCase
- (imethod (id) testRangeException is
- (set name nil)
- (set before nil)
- (set after nil)
- (set z nil)
- (try
- (set before "this should always be set")
- ((NSArray array) objectAtIndex:1)
- (set after "this should never be set")
- (catch (exception) (set name (exception name)))
- (finally (set z 99)))
- (assert_equal "this should always be set" before)
- (assert_equal nil after)
- (assert_equal "NSRangeException" name)
- (assert_equal 99 z))
+ (- (id) testRangeException is
+ (set name nil)
+ (set before nil)
+ (set after nil)
+ (set z nil)
+ (try
+ (set before "this should always be set")
+ ((NSArray array) objectAtIndex:1)
+ (set after "this should never be set")
+ (catch (exception) (set name (exception name)))
+ (finally (set z 99)))
+ (assert_equal "this should always be set" before)
+ (assert_equal nil after)
+ (assert_equal "NSRangeException" name)
+ (assert_equal 99 z))
- (imethod (id) testUserRaisedException is
- (set name nil)
- (set before nil)
- (set after nil)
- (set z nil)
- (try
- (set before "this should always be set")
- (((NSException alloc) initWithName:"UserException" reason:"" userInfo:nil) raise)
- (set after "this should never be set")
- (catch (exception) (set name (exception name)))
- (finally (set z 99)))
- (assert_equal "this should always be set" before)
- (assert_equal nil after)
- (assert_equal "UserException" name)
- (assert_equal 99 z))
+ (- (id) testUserRaisedException is
+ (set name nil)
+ (set before nil)
+ (set after nil)
+ (set z nil)
+ (try
+ (set before "this should always be set")
+ (((NSException alloc) initWithName:"UserException" reason:"" userInfo:nil) raise)
+ (set after "this should never be set")
+ (catch (exception) (set name (exception name)))
+ (finally (set z 99)))
+ (assert_equal "this should always be set" before)
+ (assert_equal nil after)
+ (assert_equal "UserException" name)
+ (assert_equal 99 z))
(if (eq (uname) "Darwin")
- (imethod (id) testUserThrownException is
- (set name nil)
- (set before nil)
- (set after nil)
- (set z nil)
- (try
- (set before "this should always be set")
- (throw ((NSException alloc) initWithName:"UserException" reason:"" userInfo:nil))
- (set after "this should never be set")
- (catch (exception) (set name (exception name)))
- (finally (set z 99)))
- (assert_equal "this should always be set" before)
- (assert_equal nil after)
- (assert_equal "UserException" name)
- (assert_equal 99 z))
+ (- (id) testUserThrownException is
+ (set name nil)
+ (set before nil)
+ (set after nil)
+ (set z nil)
+ (try
+ (set before "this should always be set")
+ (throw ((NSException alloc) initWithName:"UserException" reason:"" userInfo:nil))
+ (set after "this should never be set")
+ (catch (exception) (set name (exception name)))
+ (finally (set z 99)))
+ (assert_equal "this should always be set" before)
+ (assert_equal nil after)
+ (assert_equal "UserException" name)
+ (assert_equal 99 z))
- (imethod (id) testUserThrownObject is
- (set object nil)
- (set before nil)
- (set after nil)
- (set z nil)
- (try
- (set before "this should always be set")
- (throw 99)
- (catch (thrown) (set object thrown))
- (finally (set z 99)))
- (assert_equal "this should always be set" before)
- (assert_equal nil after)
- (assert_equal 99 object)
- (assert_equal 99 z))
+ (- (id) testUserThrownObject is
+ (set object nil)
+ (set before nil)
+ (set after nil)
+ (set z nil)
+ (try
+ (set before "this should always be set")
+ (throw 99)
+ (catch (thrown) (set object thrown))
+ (finally (set z 99)))
+ (assert_equal "this should always be set" before)
+ (assert_equal nil after)
+ (assert_equal 99 object)
+ (assert_equal 99 z))
- (imethod (id) testAssertThrown is
- (assert_throws "UserException"
- (do () (throw ((NSException alloc) initWithName:"UserException" reason:"" userInfo:nil)))))))
+ (- (id) testAssertThrown is
+ (assert_throws "UserException"
+ (do () (throw ((NSException alloc) initWithName:"UserException" reason:"" userInfo:nil)))))))
View
40 test/test_interface.nu
@@ -5,25 +5,25 @@
(class TestInterface is NuTestCase
- ;; all of these calls could be made from Objective-C
+ ;; all of these calls could be made from Objective-C
;; using methods that are declared in Nu/Nu.h
- (imethod (id) testParser is
- ;; create a parser
- (set parser (Nu parser))
- ;; set a variable in the top-level context using KVC
- (parser setValue:2 forKey:"x")
- ;; parse text into an evaluatable object
- (set code (parser parse:"(set x (+ x x))"))
- ;; evaluate the parsed code
- (set result (parser eval:code))
- (assert_equal 4 result)
- ;; parsed code objects can be evaluated any number of times
- (set result (parser eval:code))
- (assert_equal 8 result)
- ;; KVC is broadly interpreted to allow any Nu expression as a key
- (assert_equal 16 (parser valueForKey:"(+ x x)"))
- ;; But for setting, the key must be a symbol name
- (parser setValue:"hello" forKey:"y")
- ;; Symbol values can also be looked up using parse: and eval:
- (assert_equal "hello" (parser eval:(parser parse:"y")))))
+ (- (id) testParser is
+ ;; create a parser
+ (set parser (Nu parser))
+ ;; set a variable in the top-level context using KVC
+ (parser setValue:2 forKey:"x")
+ ;; parse text into an evaluatable object
+ (set code (parser parse:"(set x (+ x x))"))
+ ;; evaluate the parsed code
+ (set result (parser eval:code))
+ (assert_equal 4 result)
+ ;; parsed code objects can be evaluated any number of times
+ (set result (parser eval:code))
+ (assert_equal 8 result)
+ ;; KVC is broadly interpreted to allow any Nu expression as a key
+ (assert_equal 16 (parser valueForKey:"(+ x x)"))
+ ;; But for setting, the key must be a symbol name
+ (parser setValue:"hello" forKey:"y")
+ ;; Symbol values can also be looked up using parse: and eval:
+ (assert_equal "hello" (parser eval:(parser parse:"y")))))
View
174 test/test_macros.nu
@@ -5,103 +5,103 @@
(class TestMacros is NuTestCase
- (imethod (id) testFactorialFunction is
- (function fact (x)
- (if (== x 0)
- (then 1)
- (else (* (fact (- x 1)) x))))
- (assert_equal 24 (fact 4)))
+ (- (id) testFactorialFunction is
+ (function fact (x)
+ (if (== x 0)
+ (then 1)
+ (else (* (fact (- x 1)) x))))
+ (assert_equal 24 (fact 4)))
;; recursive macro test case done wrong.
;; because x is not a gensym it keeps getting redefined in the recursive descent
- (imethod (id) testBrokenFactorialMacro is
- (macro-0 mfact
- (set x (eval (car margs)))
- (if (== x 0)
- (then 1)
- (else (* (mfact (- x 1)) x))))
- (assert_equal 0 (mfact 4)))
+ (- (id) testBrokenFactorialMacro is
+ (macro-0 mfact
+ (set x (eval (car margs)))
+ (if (== x 0)
+ (then 1)
+ (else (* (mfact (- x 1)) x))))
+ (assert_equal 0 (mfact 4)))
;; recursive macro test case done right.
;; names prefixed with the "__" sigil are gensyms.
- (imethod (id) testFactorialMacro is
- (macro-0 mfact
- (set __x (eval (car margs)))
- (if (== __x 0)
- (then 1)
- (else (* (mfact (- __x 1)) __x))))
- (assert_equal 24 (mfact 4)))
+ (- (id) testFactorialMacro is
+ (macro-0 mfact
+ (set __x (eval (car margs)))
+ (if (== __x 0)
+ (then 1)
+ (else (* (mfact (- __x 1)) __x))))
+ (assert_equal 24 (mfact 4)))
;; test string interpolation of gensyms
- (imethod (id) testGensymInterpolation is
- (macro-0 interpolateGensym
- (set __x 123)
- (set __y 456)
- "you got #{__x} and #{__y}")
- (assert_equal "you got 123 and 456" (interpolateGensym)))
+ (- (id) testGensymInterpolation is
+ (macro-0 interpolateGensym
+ (set __x 123)
+ (set __y 456)
+ "you got #{__x} and #{__y}")
+ (assert_equal "you got 123 and 456" (interpolateGensym)))
;; test some macro implementation details
- (imethod (id) testMacroImplementation is
- (set s (NuSymbolTable sharedSymbolTable))
- (macro-0 forty (set __x 22) (set __y (+ __x 18)))
- (set newBody (send forty body:(send forty body) withGensymPrefix:"g999" symbolTable:s))
- (assert_equal "((set g999__x 22) (set g999__y (+ g999__x 18)))" (newBody stringValue)))
+ (- (id) testMacroImplementation is
+ (set s (NuSymbolTable sharedSymbolTable))
+ (macro-0 forty (set __x 22) (set __y (+ __x 18)))
+ (set newBody (send forty body:(send forty body) withGensymPrefix:"g999" symbolTable:s))
+ (assert_equal "((set g999__x 22) (set g999__y (+ g999__x 18)))" (newBody stringValue)))
;; test a macro that adds an ivar with a getter and setter
- (imethod (id) testIvarAccessorMacro is
- (function make-setter-name (oldName)
- (set newName "set")
- (newName appendString:((oldName substringToIndex:1) capitalizedString))
- (newName appendString:((oldName substringFromIndex:1)))
- (newName appendString:":")
- newName)
-
- (macro-0 reader
- (set __name ((car margs) stringValue))
- (_class addInstanceVariable:__name
- signature:"@")
- (_class addInstanceMethod:__name
- signature:"@@:"
- body:(do () (self valueForIvar:__name))))
-
- (macro-0 writer
- (set __name ((car margs) stringValue))
- (_class addInstanceVariable:__name
- signature:"@")
- (_class addInstanceMethod:(make-setter-name __name)
- signature:"v@:@"
- body:(do (new) (self setValue:new forIvar:__name))))
-
- (macro-0 accessor
- (set __name ((car margs) stringValue))
- (_class addInstanceVariable:__name
- signature:"@")
- (_class addInstanceMethod:__name
- signature:"@@:"
- body:(do () (self valueForIvar:__name)))
- (_class addInstanceMethod:(make-setter-name __name)
- signature:"v@:@"
- body:(do (new) (self setValue:new forIvar:__name))))
-
- (class SomeObject is NSObject
- (accessor greeting)
- (- init is
- (super init)
- (set @greeting "Hello, there!")
- self))
-
- (set tester ((SomeObject alloc) init))
- (assert_equal "Hello, there!" (tester greeting))
- (tester setGreeting:"Howdy!")
- (assert_equal "Howdy!" (tester greeting)))
+ (- (id) testIvarAccessorMacro is
+ (function make-setter-name (oldName)
+ (set newName "set")
+ (newName appendString:((oldName substringToIndex:1) capitalizedString))
+ (newName appendString:((oldName substringFromIndex:1)))
+ (newName appendString:":")
+ newName)
+
+ (macro-0 reader
+ (set __name ((car margs) stringValue))
+ (_class addInstanceVariable:__name
+ signature:"@")
+ (_class addInstanceMethod:__name
+ signature:"@@:"
+ body:(do () (self valueForIvar:__name))))
+
+ (macro-0 writer
+ (set __name ((car margs) stringValue))
+ (_class addInstanceVariable:__name
+ signature:"@")
+ (_class addInstanceMethod:(make-setter-name __name)
+ signature:"v@:@"
+ body:(do (new) (self setValue:new forIvar:__name))))
+
+ (macro-0 accessor
+ (set __name ((car margs) stringValue))
+ (_class addInstanceVariable:__name
+ signature:"@")
+ (_class addInstanceMethod:__name
+ signature:"@@:"
+ body:(do () (self valueForIvar:__name)))
+ (_class addInstanceMethod:(make-setter-name __name)
+ signature:"v@:@"
+ body:(do (new) (self setValue:new forIvar:__name))))
+
+ (class SomeObject is NSObject
+ (accessor greeting)
+ (- init is
+ (super init)
+ (set @greeting "Hello, there!")
+ self))
+
+ (set tester ((SomeObject alloc) init))
+ (assert_equal "Hello, there!" (tester greeting))
+ (tester setGreeting:"Howdy!")
+ (assert_equal "Howdy!" (tester greeting)))
- (imethod (id) testExceptionInMacro is
- # template contains an undefined symbol, watch the exceptions thrown by each macro call
- (set string "<%= (+ 2 x) %>")
- (load "template")
- (assert_throws "NuUndefinedSymbol"
- (macro-0 undefined0 (eval (NuTemplate codeForString:(eval (margs car)))))
- (undefined0 string))
- (assert_throws "NuUndefinedSymbol"
- (macro-1 undefined1 (string) `(eval (NuTemplate codeForString:,string)))
- (undefined1 string))))
+ (- (id) testExceptionInMacro is
+ # template contains an undefined symbol, watch the exceptions thrown by each macro call
+ (set string "<%= (+ 2 x) %>")
+ (load "template")
+ (assert_throws "NuUndefinedSymbol"
+ (macro-0 undefined0 (eval (NuTemplate codeForString:(eval (margs car)))))
+ (undefined0 string))
+ (assert_throws "NuUndefinedSymbol"
+ (macro-1 undefined1 (string) `(eval (NuTemplate codeForString:,string)))
+ (undefined1 string))))
View
396 test/test_macrox.nu
@@ -5,201 +5,201 @@
(class TestMacrox is NuTestCase
- (imethod (id) testIncMacro is
- (macro-1 inc! (n)
- `(set ,n (+ ,n 1)))
-
- ;; Test the macro evaluation
- (set a 0)
- (inc! a)
- (assert_equal 1 a)
-
- ;; Test the expansion
- (set newBody (macrox (inc! a)))
- (assert_equal "(set a (+ a 1))" (newBody stringValue)))
-
- (imethod (id) testNestedMacro is
- (macro-1 inc! (n)
- `(set ,n (+ ,n 1)))
-
- (macro-1 inc2! (n)
- `(progn
- (inc! ,n)
- (inc! ,n)))
-
- (set a 0)
- (inc2! a)
- (assert_equal 2 a)
-
- (set newBody (macrox (inc2! a)))
- (assert_equal "(progn (inc! a) (inc! a))" (newBody stringValue)))
-
-
- (imethod (id) testFactorialMacro is
- (macro-1 mfact (n)
- `(if (== ,n 0)
- (then 1)
- (else (* (mfact (- ,n 1)) ,n))))
-
- (set newBody (macrox (mfact x)))
- (assert_equal "(if (== x 0) (then 1) (else (* (mfact (- x 1)) x)))" (newBody stringValue))
-
- (set x 4)
-
- (assert_equal 24 (mfact x)))
-
- (imethod (id) testCallingContextForMacro is
- ;; Make sure we didn't ruin our calling context
- (macro-1 mfact (n)
- `(if (== ,n 0)
- (then 1)
- (else (* (mfact (- ,n 1)) ,n))))
- (set n 10)
- (mfact 4)
- (assert_equal 10 n))
-
-
- (imethod (id) testRestMacro is
- (macro-1 myfor ((var start stop) *body)
- `(let ((,var ,start))
- (while (<= ,var ,stop)
- ,@*body
- (set ,var (+ ,var 1)))))
-
- (set var 0)
- (myfor (i 1 10)
- (set var (+ var i)))
- (assert_equal 55 var)
-
- ;; Make sure we didn't pollute our context
- (assert_throws "NuUndefinedSymbol"
- (puts "#{i}")))
-
- (imethod (id) testNullArgMacro is
- ;; Make sure *args is set correctly with a null arg macro
- (macro-1 set-a-to-1 ()
- (set a 1))
-
- (set-a-to-1)
- (assert_equal 1 a))
-
- (imethod (id) testBadArgsNullMacro is
- (macro-1 nullargs ()
- nil)
-
- (assert_throws "NuDestructureException" (nullargs 1 2)))
-
- (imethod (id) testNoBindingsMacro is
- (macro-1 no-bindings (_)
- nil)
-
- (assert_equal nil (no-bindings 1)))
-
- (imethod (id) testMissingSequenceArgument is
- (macro-1 missing-sequence (_ b)
- b)
-
- (assert_throws "NuDestructureException" (missing-sequence 1)))
-
- (imethod (id) testSkipBindingsMacro is
- (macro-1 skip-bindings (_ b)
- b)
-
- (assert_equal 2 (skip-bindings 1 2)))
-
- (imethod (id) testSingleCatchAllArgMacro is
- (macro-1 single-arg (*rest)
- (cons '+ *rest))
-
- (assert_equal 6 (single-arg 1 2 3)))
-
- (imethod (id) testDoubleCatchAllArgMacro is
- (macro-1 double-catch-all ((a *b) (c *d))
- `(append (quote ,*b) (quote ,*d)))
-
- (assert_equal '(2 3 4 12 13 14) (double-catch-all (1 2 3 4) (11 12 13 14))))
-
- (imethod (id) testRestoreImplicitArgsExceptionMacro is
- (macro-1 concat ()
- (cons '+ *args))
-
- (assert_throws "NuDestructureException" (concat 1 2 3))
-
- ;; We're in a block, so *args is defined
- ;; but should be nil since our block takes
- ;; no arguments.
-
- ;; Don't pass *args to another macro
- (set defaultargs *args)
- (assert_equal nil defaultargs))
-
- (imethod (id) testRestoreArgsExceptionMacro is
- ;; Intentionally refer to undefined symbol
- (macro-1 x (a b)
- c)
-
- (set a 0)
- (assert_throws "NuUndefinedSymbol" (x 1 2))
-
- ;; Don't pass *args to another macro
- (set defaultargs *args)
- (assert_equal nil defaultargs)
- (assert_equal 0 a)
- (assert_throws "NuUndefinedSymbol" b))
-
- (imethod (id) testEvalExceptionMacro is
- ;; Make sure a runtime exception is properly caught
- (set code '(+ 2 x))
-
- (macro-1 eval-it (sexp) `(eval ,sexp))
- (assert_throws "NuUndefinedSymbol" (eval-it code)))
-
- (imethod (id) testMaskedVariablesMacro is
- (macro-1 x (a b)
- `(+ ,a ,b))
-
- (set a 1)
- (assert_equal 5 (x 2 3))
- (assert_equal 1 a))
-
- (imethod (id) testEmptyListArgsMacro is
- (macro-1 donothing (a b)
- b)
-
- (assert_equal 2 (donothing 1 2))
- (assert_equal 2 (donothing () 2))
- (assert_equal 2 (donothing nil 2)))
-
- (imethod (id) testEmptyListArgsRecursiveMacro is
- (macro-1 let* (bindings *body)
- (if (null? *body)
- (then
- (throw* "LetException"
- "An empty body was passed to let*")))
- (if (null? bindings)
- (then
- `(progn
- ,@*body))
- (else
- (set __nextcall `(let* ,(cdr bindings) ,@*body))
- `(let (,(car bindings))
- ,__nextcall))))
-
- (assert_equal 3
- (let* ((a 1)
- (b (+ a a)))
- (+ a b)))
-
- (assert_equal 3
- (let* ()
- (+ 2 1)))
-
- (assert_throws "LetException"
- (let* () )))
-
- (imethod (id) testDisruptCallingContextMacro is
- (macro-1 leaky-macro (a b)
- `(set c (+ ,a ,b)))
-
- (assert_equal 5 (leaky-macro 2 3))
- (assert_equal 5 c)))
+ (- (id) testIncMacro is
+ (macro-1 inc! (n)
+ `(set ,n (+ ,n 1)))
+
+ ;; Test the macro evaluation
+ (set a 0)
+ (inc! a)
+ (assert_equal 1 a)
+
+ ;; Test the expansion
+ (set newBody (macrox (inc! a)))
+ (assert_equal "(set a (+ a 1))" (newBody stringValue)))
+
+ (- (id) testNestedMacro is
+ (macro-1 inc! (n)
+ `(set ,n (+ ,n 1)))
+
+ (macro-1 inc2! (n)
+ `(progn
+ (inc! ,n)
+ (inc! ,n)))
+
+ (set a 0)
+ (inc2! a)
+ (assert_equal 2 a)
+
+ (set newBody (macrox (inc2! a)))
+ (assert_equal "(progn (inc! a) (inc! a))" (newBody stringValue)))
+
+
+ (- (id) testFactorialMacro is
+ (macro-1 mfact (n)
+ `(if (== ,n 0)
+ (then 1)
+ (else (* (mfact (- ,n 1)) ,n))))
+
+ (set newBody (macrox (mfact x)))
+ (assert_equal "(if (== x 0) (then 1) (else (* (mfact (- x 1)) x)))" (newBody stringValue))
+
+ (set x 4)
+
+ (assert_equal 24 (mfact x)))
+
+ (- (id) testCallingContextForMacro is
+ ;; Make sure we didn't ruin our calling context
+ (macro-1 mfact (n)
+ `(if (== ,n 0)
+ (then 1)
+ (else (* (mfact (- ,n 1)) ,n))))
+ (set n 10)
+ (mfact 4)
+ (assert_equal 10 n))
+
+
+ (- (id) testRestMacro is
+ (macro-1 myfor ((var start stop) *body)
+ `(let ((,var ,start))
+ (while (<= ,var ,stop)
+ ,@*body
+ (set ,var (+ ,var 1)))))
+
+ (set var 0)
+ (myfor (i 1 10)
+ (set var (+ var i)))
+ (assert_equal 55 var)
+
+ ;; Make sure we didn't pollute our context
+ (assert_throws "NuUndefinedSymbol"
+ (puts "#{i}")))
+
+ (- (id) testNullArgMacro is
+ ;; Make sure *args is set correctly with a null arg macro
+ (macro-1 set-a-to-1 ()
+ (set a 1))
+
+ (set-a-to-1)
+ (assert_equal 1 a))
+
+ (- (id) testBadArgsNullMacro is
+ (macro-1 nullargs ()
+ nil)
+
+ (assert_throws "NuDestructureException" (nullargs 1 2)))
+
+ (- (id) testNoBindingsMacro is
+ (macro-1 no-bindings (_)
+ nil)
+
+ (assert_equal nil (no-bindings 1)))
+
+ (- (id) testMissingSequenceArgument is
+ (macro-1 missing-sequence (_ b)
+ b)
+
+ (assert_throws "NuDestructureException" (missing-sequence 1)))
+
+ (- (id) testSkipBindingsMacro is
+ (macro-1 skip-bindings (_ b)
+ b)
+
+ (assert_equal 2 (skip-bindings 1 2)))
+
+ (- (id) testSingleCatchAllArgMacro is
+ (macro-1 single-arg (*rest)
+ (cons '+ *rest))
+
+ (assert_equal 6 (single-arg 1 2 3)))
+
+ (- (id) testDoubleCatchAllArgMacro is
+ (macro-1 double-catch-all ((a *b) (c *d))
+ `(append (quote ,*b) (quote ,*d)))
+
+ (assert_equal '(2 3 4 12 13 14) (double-catch-all (1 2 3 4) (11 12 13 14))))
+
+ (- (id) testRestoreImplicitArgsExceptionMacro is
+ (macro-1 concat ()
+ (cons '+ *args))
+
+ (assert_throws "NuDestructureException" (concat 1 2 3))
+
+ ;; We're in a block, so *args is defined
+ ;; but should be nil since our block takes
+ ;; no arguments.
+
+ ;; Don't pass *args to another macro
+ (set defaultargs *args)
+ (assert_equal nil defaultargs))
+
+ (- (id) testRestoreArgsExceptionMacro is
+ ;; Intentionally refer to undefined symbol
+ (macro-1 x (a b)
+ c)
+
+ (set a 0)
+ (assert_throws "NuUndefinedSymbol" (x 1 2))
+
+ ;; Don't pass *args to another macro
+ (set defaultargs *args)
+ (assert_equal nil defaultargs)
+ (assert_equal 0 a)
+ (assert_throws "NuUndefinedSymbol" b))
+
+ (- (id) testEvalExceptionMacro is
+ ;; Make sure a runtime exception is properly caught
+ (set code '(+ 2 x))
+
+ (macro-1 eval-it (sexp) `(eval ,sexp))
+ (assert_throws "NuUndefinedSymbol" (eval-it code)))
+
+ (- (id) testMaskedVariablesMacro is
+ (macro-1 x (a b)
+ `(+ ,a ,b))
+
+ (set a 1)
+ (assert_equal 5 (x 2 3))
+ (assert_equal 1 a))
+
+ (- (id) testEmptyListArgsMacro is
+ (macro-1 donothing (a b)
+ b)
+
+ (assert_equal 2 (donothing 1 2))
+ (assert_equal 2 (donothing () 2))
+ (assert_equal 2 (donothing nil 2)))
+
+ (- (id) testEmptyListArgsRecursiveMacro is
+ (macro-1 let* (bindings *body)
+ (if (null? *body)
+ (then
+ (throw* "LetException"
+ "An empty body was passed to let*")))
+ (if (null? bindings)
+ (then
+ `(progn
+ ,@*body))
+ (else
+ (set __nextcall `(let* ,(cdr bindings) ,@*body))
+ `(let (,(car bindings))
+ ,__nextcall))))
+
+ (assert_equal 3
+ (let* ((a 1)
+ (b (+ a a)))
+ (+ a b)))
+
+ (assert_equal 3
+ (let* ()
+ (+ 2 1)))
+
+ (assert_throws "LetException"
+ (let* () )))
+
+ (- (id) testDisruptCallingContextMacro is
+ (macro-1 leaky-macro (a b)
+ `(set c (+ ,a ,b)))
+
+ (assert_equal 5 (leaky-macro 2 3))
+ (assert_equal 5 c)))
View
488 test/test_match.nu
@@ -6,259 +6,259 @@
(load "match")
(if (eq (uname) "Darwin") ;; pattern matching is broken on Linux because it relies on throw, which is not working with the GNU runtime.
-
-(class TestDestructuring is NuTestCase
-
- (imethod (id) testFindFirstMatch is
- (assert_equal '() (_find-first-match 1 '()))
- (assert_equal '(let () 2) (_find-first-match 1 '((1 2))))
- (assert_equal '(let () 4) (_find-first-match 3 '((1 2) (3 4))))
- (assert_equal '(let () 5) (_find-first-match 'a '((1 2) ('a 5) (3 4))))
- (assert_equal '(let ((a 1) (b 2)) a)
- (_find-first-match '(1 2) '(((a b) a) ((a) a))))
- (assert_equal '(let ((a 1)) 1)
- (_find-first-match 1 '((a 1) (b 2)))))
-
- ;; match
- (imethod (id) testMatch is
- (assert_equal 1 (match 1 (x x)))
- (assert_equal 2 (match 2 (x x) (y (+ y 1)))) ;; First match is used.
-
- (assert_equal 'nothing (match nil (0 'zero) (nil 'nothing)))
-
- ;; Make sure nil doesn't get treated as a pattern name.
- (assert_equal 'nada (match 0 (nil 'zilch) (x 'nada)))
-
- (assert_equal '(1 2) (match '(1 2) ((a a) a) ((a b) (list a b))))
-
- (function people-to-string (people)
- (match people
- (() "no people")
- ((p1) "one person: #{p1}")
- ((p1 p2) "two people: #{p1} and #{p2}")
- (else "too many people: #{(people length)}")))
- (assert_equal "no people" (people-to-string '()))
- (assert_equal "one person: Tim" (people-to-string '(Tim)))
- (assert_equal "two people: Tim and Matz" (people-to-string '(Tim Matz)))
- (assert_equal "too many people: 3" (people-to-string '(Tim Guido Matz)))
-
- ;; If there is no else or wildcard (_) clause then it throws an exception.
- (assert_throws "NuMatchException"
- (match '(1 2)
- (() 'foo)
- ((a b c) 'bar))))
-
- (imethod (id) testMatchWithLiterals is
- ;; Toy algebraic simplifier
- (function simplify (expr)
- (match expr
- ((+ 0 a) a)
- ((+ a 0) a)
- ((+ a a) (list '* 2 a))
- (else expr)))
- (assert_equal 'foo (simplify '(+ 0 foo)))
- (assert_equal 'foo (simplify '(+ foo 0)))
- (assert_equal '(* 2 x) (simplify '(+ x x)))
- (assert_equal '(+ foo 1) (simplify '(+ foo 1))))
-
- (imethod (id) testMatchWithWildCards is
- (assert_equal '(1 4)
- (match '(1 (2 (3)) 4 5)
- ((a _ b _) (list a b)))))
-
- (imethod (id) testRestOfListPatterns is
- (assert_equal '(1 (2 3))
- (match '(1 2 3)
- ((a . b) (list a b))))
- (assert_equal '(1 2 (3))
- (match '(1 2 3)
- ((a b . c) (list a b c))))
-
- ;; This is probably an inefficient way to implement map.
- (function silly-map (f a-list)
- (match a-list
- (() '())
- ((head . tail)
- (cons (f head) (silly-map f tail)))))
- (function add1 (x) (+ 1 x))
- (assert_equal '() (silly-map add1 '()))
- (assert_equal '(1) (silly-map add1 '(0)))
- (assert_equal '(1 3) (silly-map add1 '(0 2)))
- (assert_equal '(1 2 3) (silly-map add1 '(0 1 2))))
-
- (imethod (id) testSymbolicLiterals is
- (assert_equal 1 (match 'a ('a 1)))
- (assert_equal 2 (match '(a 2) (('a x) x)))
- (assert_throws "NuMatchException" (match '(a 2) (('b x) x)))
-
- (function to-num (thing)
- (match thing
- ('Baz 7)
- (('Foo x) x)
- (('Bar x y) (+ x y))))
- (assert_equal 42 (to-num '(Foo 42)))
- (assert_equal 9 (to-num '(Bar 4 5)))
- (assert_equal 7 (to-num 'Baz))
-
- (function fruit-desc (fruit)
- (match fruit
- (('Apple crunchiness) "Apple #{crunchiness}-crunchy")
- (('BananaBunch n) "Banana bunch with #{n} bananas")
- (('Orange desc) "Orange #{desc}")))
-
- (assert_equal "Apple 2.5-crunchy" (fruit-desc '(Apple 2.5)))
- (assert_equal "Banana bunch with 5 bananas"
- (fruit-desc '(BananaBunch 5)))
- (assert_equal "Orange bergamot" (fruit-desc '(Orange "bergamot"))))
-
- (imethod (id) testSymbolicLiteralsInTrees is
- (assert_equal 1 (match '(a)
- ('(a) 1)
- ('a 2)))
- (assert_equal 3 (match '(a)
- ('a 2)
- ('(a) 3))))
-
- (imethod (id) testQuoteLeafSymbols is
- (assert_equal '() (_quote-leaf-symbols '()))
- (assert_equal 1 (_quote-leaf-symbols 1))
- (assert_equal '(1) (_quote-leaf-symbols '(1)))
- (assert_equal ''a (_quote-leaf-symbols 'a))
- (assert_equal '( 'a 'b) (_quote-leaf-symbols '(a b)))
- (assert_equal '(('a 'c) 'b) (_quote-leaf-symbols '((a c) b)))
- (assert_equal '( 'a ('c 'b)) (_quote-leaf-symbols '(a (c b)))))
-
- (imethod (id) testCheckBindings is
- (check-bindings '()) ;; empty set of bindings should not throw
- (check-bindings '((a 1)))
- (check-bindings '((a 1) (a 1))) ;; consistent
- (assert_throws "NuMatchException"
- (do () (check-bindings '((a 1) (a 2)))))) ;; inconsistent
-
- ;; match-do
- (imethod (id) testMatchDo is
- (set f (match-do (() 1)))
- (assert_equal 1 (f))
- (assert_throws "NuMatchException" (f 'extra_arg))
-
- (set f (match-do (() nil) ((a) a)))
- (assert_equal nil (f))
- (assert_equal 1 (f 1))
- (assert_throws "NuMatchException" (f 1 'extra_arg))
-
- (set f (match-do ((((a) b)) (list a b)) (_ 'default)))
- (assert_equal '(1 2) (f '((1) 2)))
- (assert_equal 'default (f))
- (assert_equal 'default (f 1))
- (assert_equal 'default (f 1 2)))
-
- ;; match-function
- (imethod (id) testMatchFunction is
- (match-function f
- (() 0)
- ((a) 1)
- ((a b) 2)
- (_ 'many))
- (assert_equal 0 (f))
- (assert_equal 1 (f 'a))
- (assert_equal 2 (f 'a 'b))
- (assert_equal 'many (f 'a 'b 'c))
-
- (match-function f
- (((a)) a)
- (((a (b))) (list b a))
- (((a (b (c)))) (list a b c)))
-
- (assert_equal 2 (f '(2)))
- (assert_equal '(1 3) (f '(3 (1))))
- (assert_equal '(7 8 9) (f '(7 (8 (9)))))
- (assert_throws "NuMatchException" (f 1))
-
- (function slow-map (f lst)
- (match-function loop
- ((nil) '())
- (((a . rest))
- (cons (f a) (loop rest))))
- (loop lst))
- (function add-1 (x) (+ x 1))
- (assert_equal '() (slow-map add-1 '()))
- (assert_equal '(1) (slow-map add-1 '(0)))
- (assert_equal '(1 2) (slow-map add-1 '(0 1)))
- (assert_equal '(4 3 2) (slow-map add-1 '(3 2 1))))
-
- ;; match-let1
- (imethod (id) testMatchLet1 is
- (assert_equal 3 (match-let1 a 3
+
+ (class TestDestructuring is NuTestCase
+
+ (- (id) testFindFirstMatch is
+ (assert_equal '() (_find-first-match 1 '()))
+ (assert_equal '(let () 2) (_find-first-match 1 '((1 2))))
+ (assert_equal '(let () 4) (_find-first-match 3 '((1 2) (3 4))))
+ (assert_equal '(let () 5) (_find-first-match 'a '((1 2) ('a 5) (3 4))))
+ (assert_equal '(let ((a 1) (b 2)) a)
+ (_find-first-match '(1 2) '(((a b) a) ((a) a))))
+ (assert_equal '(let ((a 1)) 1)
+ (_find-first-match 1 '((a 1) (b 2)))))
+
+ ;; match
+ (- (id) testMatch is
+ (assert_equal 1 (match 1 (x x)))
+ (assert_equal 2 (match 2 (x x) (y (+ y 1)))) ;; First match is used.
+
+ (assert_equal 'nothing (match nil (0 'zero) (nil 'nothing)))
+
+ ;; Make sure nil doesn't get treated as a pattern name.
+ (assert_equal 'nada (match 0 (nil 'zilch) (x 'nada)))
+
+ (assert_equal '(1 2) (match '(1 2) ((a a) a) ((a b) (list a b))))
+
+ (function people-to-string (people)
+ (match people
+ (() "no people")
+ ((p1) "one person: #{p1}")
+ ((p1 p2) "two people: #{p1} and #{p2}")
+ (else "too many people: #{(people length)}")))
+ (assert_equal "no people" (people-to-string '()))
+ (assert_equal "one person: Tim" (people-to-string '(Tim)))
+ (assert_equal "two people: Tim and Matz" (people-to-string '(Tim Matz)))
+ (assert_equal "too many people: 3" (people-to-string '(Tim Guido Matz)))
+
+ ;; If there is no else or wildcard (_) clause then it throws an exception.
+ (assert_throws "NuMatchException"
+ (match '(1 2)
+ (() 'foo)
+ ((a b c) 'bar))))
+
+ (- (id) testMatchWithLiterals is
+ ;; Toy algebraic simplifier
+ (function simplify (expr)
+ (match expr
+ ((+ 0 a) a)
+ ((+ a 0) a)
+ ((+ a a) (list '* 2 a))
+ (else expr)))
+ (assert_equal 'foo (simplify '(+ 0 foo)))
+ (assert_equal 'foo (simplify '(+ foo 0)))
+ (assert_equal '(* 2 x) (simplify '(+ x x)))
+ (assert_equal '(+ foo 1) (simplify '(+ foo 1))))
+
+ (- (id) testMatchWithWildCards is
+ (assert_equal '(1 4)
+ (match '(1 (2 (3)) 4 5)
+ ((a _ b _) (list a b)))))
+
+ (- (id) testRestOfListPatterns is
+ (assert_equal '(1 (2 3))
+ (match '(1 2 3)
+ ((a . b) (list a b))))
+ (assert_equal '(1 2 (3))
+ (match '(1 2 3)
+ ((a b . c) (list a b c))))
+
+ ;; This is probably an inefficient way to implement map.
+ (function silly-map (f a-list)
+ (match a-list
+ (() '())
+ ((head . tail)
+ (cons (f head) (silly-map f tail)))))
+ (function add1 (x) (+ 1 x))
+ (assert_equal '() (silly-map add1 '()))
+ (assert_equal '(1) (silly-map add1 '(0)))
+ (assert_equal '(1 3) (silly-map add1 '(0 2)))
+ (assert_equal '(1 2 3) (silly-map add1 '(0 1 2))))
+
+ (- (id) testSymbolicLiterals is
+ (assert_equal 1 (match 'a ('a 1)))
+ (assert_equal 2 (match '(a 2) (('a x) x)))
+ (assert_throws "NuMatchException" (match '(a 2) (('b x) x)))
+
+ (function to-num (thing)
+ (match thing
+ ('Baz 7)
+ (('Foo x) x)
+ (('Bar x y) (+ x y))))
+ (assert_equal 42 (to-num '(Foo 42)))
+ (assert_equal 9 (to-num '(Bar 4 5)))
+ (assert_equal 7 (to-num 'Baz))
+
+ (function fruit-desc (fruit)
+ (match fruit
+ (('Apple crunchiness) "Apple #{crunchiness}-crunchy")
+ (('BananaBunch n) "Banana bunch with #{n} bananas")
+ (('Orange desc) "Orange #{desc}")))
+
+ (assert_equal "Apple 2.5-crunchy" (fruit-desc '(Apple 2.5)))
+ (assert_equal "Banana bunch with 5 bananas"
+ (fruit-desc '(BananaBunch 5)))
+ (assert_equal "Orange bergamot" (fruit-desc '(Orange "bergamot"))))
+
+ (- (id) testSymbolicLiteralsInTrees is
+ (assert_equal 1 (match '(a)
+ ('(a) 1)
+ ('a 2)))
+ (assert_equal 3 (match '(a)
+ ('a 2)
+ ('(a) 3))))
+
+ (- (id) testQuoteLeafSymbols is
+ (assert_equal '() (_quote-leaf-symbols '()))
+ (assert_equal 1 (_quote-leaf-symbols 1))
+ (assert_equal '(1) (_quote-leaf-symbols '(1)))
+ (assert_equal ''a (_quote-leaf-symbols 'a))
+ (assert_equal '( 'a 'b) (_quote-leaf-symbols '(a b)))
+ (assert_equal '(('a 'c) 'b) (_quote-leaf-symbols '((a c) b)))
+ (assert_equal '( 'a ('c 'b)) (_quote-leaf-symbols '(a (c b)))))
+
+ (- (id) testCheckBindings is
+ (check-bindings '()) ;; empty set of bindings should not throw
+ (check-bindings '((a 1)))
+ (check-bindings '((a 1) (a 1))) ;; consistent
+ (assert_throws "NuMatchException"
+ (do () (check-bindings '((a 1) (a <