carp-lang/Carp
1
1
Fork 0
mirror of https://github.com/carp-lang/Carp.git synced 2024-09-11 05:25:28 +03:00
Code Issues Projects Releases Wiki Activity

core/Tuples.carp: < and > for Pair and PairRef

Browse Source
This commit is contained in:
Joel Kaasinen 2018-12-09 18:34:10 +02:00
parent 31824bcadb
commit 77a15e49d2
2 changed files with 46 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
core/Tuples.carp
View File

@ -1,5 +1,21 @@
(deftype (Pair a b) [a a b b])
(defmodule PairRef
(defn = [p1 p2]
(and (= (Pair.a p1) (Pair.a p2))
(= (Pair.b p1) (Pair.b p2))))
(defn /= [p1 p2]
(not (PairRef.= p1 p2)))
(defn < [p1 p2]
(if (= (Pair.a p1) (Pair.a p2))
(< (Pair.b p1) (Pair.b p2))
(< (Pair.a p1) (Pair.a p2))))
(defn > [p1 p2]
(PairRef.< p2 p1)))
(defmodule Pair
(defn init-from-refs [r1 r2]
(Pair.init @r1 @r2))
@ -11,12 +27,10 @@
(defn /= [p1 p2]
(not (Pair.= p1 p2)))
(defn < [p1 p2]
(PairRef.< &p1 &p2))
(defn > [p1 p2]
(PairRef.> &p1 &p2))
)
(defmodule PairRef
(defn = [p1 p2]
(and (= (Pair.a p1) (Pair.a p2))
(= (Pair.b p1) (Pair.b p2))))
(defn /= [p1 p2]
(not (PairRef.= p1 p2))))

24
test/tuples.carp Normal file
View File

@ -0,0 +1,24 @@
(load "Tuples.carp")
(load "Test.carp")
(use Test)
(deftest test
(assert-true test
(< (Pair.init 1 2) (Pair.init 2 2))
"comparison works I")
(assert-true test
(< (Pair.init 2 1) (Pair.init 2 2))
"comparison works II")
(assert-true test
(< (Pair.init 1 100) (Pair.init 2 2))
"comparison works III")
(assert-false test
(< (Pair.init 1 100) (Pair.init 1 100))
"comparison works IV")
(assert-true test
(< &(Pair.init @"a" 2) &(Pair.init @"b" 1))
"comparison works with (Ref (Pair String Int)) I")
(assert-false test
(< &(Pair.init @"a" 2) &(Pair.init @"a" 1))
"comparison works with (Ref (Pair String Int)) II"))