Skip to content

Instantly share code, notes, and snippets.

@takei-shg
Created May 1, 2013 10:35
Show Gist options
  • Save takei-shg/5494636 to your computer and use it in GitHub Desktop.
Save takei-shg/5494636 to your computer and use it in GitHub Desktop.
Either matcher of Egison
(define $either
(lambda [$a $b]
(matcher {
;; <primitive-pp>
[,$val [a b] {[$tgt
(match [val tgt] [(either a b) (either a b)] {
[[<left $x> <left ,x>] {[x]}]
[[<right $y> <right ,y>] {[y]}]
[_ {}]
})
]}]
;; <primitive-dp>
[<left $> [a] {
[<Left $x> {[x]}]
[_ {}]
}]
[<right $> [b] {
[<Right $x> {[x]}]
[_ {}]
}]
})
)
)
(test "------------")
(test (assert-equal "right case : wildcard"
(match <Right 5> (either string integer) {[<right _> [<OK>]] [_ <KO>]})
<OK>
))
(test (assert-equal "right case : wildcard / with <left _>, not match"
(match <Right 5> (either string integer) {[<left _> [<OK>]] [_ <KO>]})
<KO>
))
(test (assert-equal "right case : return value"
(match <Right 5> (either string integer) {[<right $x> [x]] [_ <KO>]})
5
))
(test (assert-equal "left case : return message"
(match <Left "somethin lefty"> (either string integer) {[<left $x> [x]] [_ <KO>]})
"somethin lefty"
))
(test (assert-equal "left case : with <right $x>, not match"
(match <Left "somethin lefty"> (either string integer) {[<right $x> [x]] [_ <KO>]})
<KO>
))
(test (assert-equal "But, the type params is not useless."
(match <Left "somethin lefty"> (either float float) {[<left $x> [x]] [_ <KO>]})
<KO>
))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment