egison 3.5.3 → 3.5.4
raw patch · 8 files changed
+338/−317 lines, 8 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- egison.cabal +37/−10
- lib/core/base.egi +32/−25
- lib/core/collection.egi +178/−203
- lib/core/number.egi +33/−63
- lib/core/order.egi +26/−8
- lib/core/random.egi +2/−0
- lib/core/string.egi +4/−8
- sample/triangle.egi +26/−0
egison.cabal view
@@ -1,26 +1,53 @@ Name: egison-Version: 3.5.3+Version: 3.5.4 Synopsis: Programming language with non-linear pattern-matching against unfree data Description:- An interpreter for Egison, the programming langugage that realized non-linear pattern-matching against unfree data types.- With Egison, we can directly represent pattern-matching against a wide range of data types such as lists, multisets, sets, trees and graphs.+ An interpreter for Egison, a **pattern-matching-oriented**, purely functional programming language.+ We can directly represent pattern-matching against lists, multisets, sets, trees, graphs and any kind of data types.+ . We can find Egison programs in @lib@ and @sample@ directories. This package also include Emacs Lisp file @elisp/egison-mode.el@. .+ We can do non-linear pattern-matching against unfree data types in Egison.+ An unfree data type is a data type whose data have no canonical form, a standard way to represent that object.+ It enables us to write elegant programs.+ .+ /Twin Primes/+ .+ We can use pattern-matching for enumeration.+ The following code enumerates all twin primes from the infinite list of prime numbers with pattern-matching!+ .+ <<https://raw.githubusercontent.com/egison/egison/master/images/twin-primes.png>>+ .+ /Poker Hands/+ . The following code is the program that determines poker-hands written in Egison. All hands are expressed in a single pattern.- Isn't it exciting?- We can run this code online at <http://www.egison.org/demonstrations/poker-hands.html>. .- <<http://www.egison.org/images/poker-hands.png>>+ <<https://raw.githubusercontent.com/egison/egison/master/images/poker-hands.png">> .- The pattern-matching of Egison is very powerful.- Please view and try more demonstrations.+ /Mahjong/ .- <http://www.egison.org/demonstrations/>+ We can write a pattern even against mahjong tiles.+ We modularize patterns to represent complex mahjong hands.+ .+ <<https://raw.githubusercontent.com/egison/egison/master/images/mahjong.png>>+ .+ /Graphs/+ .+ We can pattern-match against graphs.+ We can write program to solve the travelling salesman problem in a single pattern-matching expression.+ .+ <<https://raw.githubusercontent.com/egison/egison/master/images/salesman.png>>+ .+ Aren't thsese exciting?+ We can run these demonstrations on our website!+ Please view and try more demonstrations!+ .+ <http://www.egison.org> . Egison makes programming dramatically simple.- Please try Egison.+ Please enjoy Egison! Homepage: http://www.egison.org License: MIT License-file: LICENSE
lib/core/base.egi view
@@ -15,33 +15,13 @@ })) (define $bool builtin-data-matcher)--(define $or- (lambda [$b1 $b2]- (if b1- #t- b2)))--(define $and- (lambda [$b1 $b2]- (if b1- b2- #f)))--(define $not- (lambda [$b]- (match b bool- {[,#t #f]- [,#f #t]})))- (define $char builtin-data-matcher)--(define $eq?/m- (lambda [$a $x $y]- (match x a- {[,y #t]- [_ #f]})))+(define $integer builtin-data-matcher)+(define $float builtin-data-matcher) +;;+;; Utility+;; (define $id 1#%1) (define $fst 2#%1)@@ -61,3 +41,30 @@ (define $ref (lambda [$xa $i] (array-ref xa i)))++(define $eq?/m+ (lambda [$a $x $y]+ (match x a+ {[,y #t]+ [_ #f]})))++;;+;; Boolean+;;+(define $and+ (lambda [$b1 $b2]+ (if b1+ b2+ #f)))++(define $or+ (lambda [$b1 $b2]+ (if b1+ #t+ b2)))++(define $not+ (lambda [$b]+ (match b bool+ {[,#t #f]+ [,#f #t]})))
lib/core/collection.egi view
@@ -81,184 +81,49 @@ }))) ;;-;; Helper function for List matcher, be careful for recursive calls-;;-(define $between- (lambda [$s $e]- (if (eq? s e)- {s}- (if (lt? s e)- {s @(between (+ s 1) e)}- {}))))--(define $from- (lambda [$s]- {s (+ s 1) (+ s 2) (+ s 3) (+ s 4) (+ s 5) (+ s 6) (+ s 7) (+ s 8) (+ s 9) (+ s 10) @(from (+ s 11))}))--(define $foldr- (lambda [$fn $init $ls]- (match ls (list something)- {[<nil> init]- [<cons $x $xs> (fn x (foldr fn init xs))]})))--;;-;; list functions+;; Accessors ;;-(define $foldl- (lambda [$fn $init $ls]- (match ls (list something)- {[<nil> init]- [<cons $x $xs>- (let {[$z (fn init x)]}- (seq z (foldl fn z xs)))]})))--(define $map- (lambda [$fn $xs]- (match xs (list something)- {[<nil> {}]- [<cons $x $rs> {(fn x) @(map fn rs)}]})))--(define $scanl- (lambda [$fn $init $ls]- {init @(match ls (list something)- {[<nil> {}]- [<cons $x $xs> (scanl fn (fn init x) xs)]})}))--(define $repeat1- (lambda [$x]- {x @(repeat1 x)}))--(define $repeat- (lambda [$xs]- {@xs @(repeat xs)}))--(define $filter- (lambda [$pred $xs]- (foldr (lambda [$y $ys] (if (pred y) {y @ys} ys))- {}- xs)))--(define $separate- (lambda [$pred $ls]- (letrec {[$helper (lambda [$ls $xs $ys]- (match ls (list something)- {[<nil> [xs ys]]- [<cons (& ?pred $l) $rs> (helper rs {l @xs} ys)]- [<cons $l $rs> (helper rs xs {l @ys})]}))]}- (helper ls {} {}))))--(define $append- (lambda [$xs $ys]- {@xs @ys}))--(define $concat- (lambda [$xss]- (foldr (lambda [$xs $rs] {@xs @rs})- {}- xss)))--(define $map2- (lambda [$fn $xs $ys]- (match [xs ys] [(list something) (list something)]- {[[<nil> <nil>] {}]- [[<cons $x $xs2> <cons $y $ys2>]- {(fn x y) @(map2 fn xs2 ys2)}]})))--(define $zip- (lambda [$xs $ys]- (map2 (lambda [$x $y] [x y]) xs ys)))--(define $find-cycle- (lambda [$xs]+(define $nth+ (lambda [$n $xs] (match xs (list something)- {[<join $s <cons $x <join $c <cons ,x _>>>> [s {x @c}]]})))--;;-;; Simple predicate-;;-(define $member?- (lambda [$x $ys]- (match ys (list something)- {[<join _ <cons ,x _>> #t]- [_ #f]})))--(define $member?/m- (lambda [$a $x $ys]- (match ys (list a)- {[<join _ <cons ,x _>> #t]- [_ #f]})))+ {[(loop $i [1 (- n 1)]+ <cons _ ...>+ <cons $x _>)+ x]}))) -(define $include?- (lambda [$a $xs $ys]+(define $take-and-drop+ (lambda [$n $xs] (match xs (list something)- {[<nil> #t]- [<cons $x $rest>- (if (member? x ys)- (include? rest ys)- #f)]})))+ {[(loop $i [1 n] <cons $a_i ...> $rs)+ [(map (lambda [$i] a_i) (between 1 n)) rs]]}))) -(define $include?/m- (lambda [$a $xs $ys]- (match xs (list something)- {[<nil> #t]- [<cons $x $rest>- (if (member?/m a x ys)- (include?/m a rest ys)- #f)]})))+(define $take+ (lambda [$n $xs]+ (if (eq? n 0)+ {}+ (match xs (list something)+ {[<cons $x $xs> {x @(take (- n 1) xs)}]+ [<nil> {}]})))) -(define $any- (lambda [$pred $xs]- (match xs (list something)- {[<nil> #f]- [<cons $x $rs>- (if (pred x)- #t- (any pred rs))]})))+(define $drop+ (lambda [$n $xs]+ (if (eq? n 0)+ xs+ (match xs (list something)+ {[<cons _ $xs> (drop (- n 1) xs)]+ [<nil> {}]})))) -(define $all+(define $while (lambda [$pred $xs] (match xs (list something)- {[<nil> #t]+ {[<nil> {}] [<cons $x $rs> (if (pred x)- (all pred rs)- #f)]})))--;;-;; Counting-;;-(define $length- (lambda [$xs]- (foldl (lambda [$r $x] (+ r 1)) 0 xs)))--(define $count- (lambda [$x $xs]- (foldl (match-lambda [something something]- {[[$r ,x] (+ r 1)]- [[$r $y] r]})- 0- xs)))--(define $count/m- (lambda [$a $x $xs]- (foldl (match-lambda [a a]- {[[$r ,x] (+ r 1)]- [[$r $y] r]})- 0- xs)))--(define $frequency- (lambda [$xs]- (let {[$us (unique xs)]}- (map (lambda [$u] [u (count u xs)]) us))))--(define $frequency/m- (lambda [$a $xs]- (let {[$us (unique/m a xs)]}- (map (lambda [$u] [u (count/m a u xs)]) us))))+ {x @(while pred rs)}+ {})]}))) ;;-;; Simple accessors+;; cons, car, cdr ;; (define $cons (lambda [$x $xs] {x @xs}))@@ -283,48 +148,67 @@ (match xs (list something) {[<snoc _ $ys> ys]}))) -(define $nth- (lambda [$n $xs]- (match xs (list something)- {[(loop $i [1 (- n 1)]- <cons _ ...>- <cons $x _>)- x]})))+;;+;; list functions+;;+(define $length+ (lambda [$xs]+ (foldl (lambda [$r $x] (+ r 1)) 0 xs))) -(define $take-and-drop- (lambda [$n $xs]+(define $map+ (lambda [$fn $xs] (match xs (list something)- {[(loop $i [1 n] <cons $a_i ...> $rs)- [(map (lambda [$i] a_i) (between 1 n)) rs]]})))+ {[<nil> {}]+ [<cons $x $rs> {(fn x) @(map fn rs)}]}))) -(define $take- (lambda [$n $xs]- (if (eq? n 0)- {}- (match xs (list something)- {[<cons $x $xs> {x @(take (- n 1) xs)}]- [<nil> {}]}))))+(define $map2+ (lambda [$fn $xs $ys]+ (match [xs ys] [(list something) (list something)]+ {[[<nil> <nil>] {}]+ [[<cons $x $xs2> <cons $y $ys2>]+ {(fn x y) @(map2 fn xs2 ys2)}]}))) -(define $drop- (lambda [$n $xs]- (if (eq? n 0)- xs- (match xs (list something)- {[<cons _ $xs> (drop (- n 1) xs)]- [<nil> {}]}))))+(define $zip+ (lambda [$xs $ys]+ (map2 (lambda [$x $y] [x y]) xs ys))) -(define $while+(define $filter (lambda [$pred $xs]- (match xs (list something)- {[<nil> {}]- [<cons $x $rs>- (if (pred x)- {x @(while pred rs)}- {})]})))+ (foldr (lambda [$y $ys] (if (pred y) {y @ys} ys))+ {}+ xs))) -;;-;; Others-;;+; Note. `foldr` is used in the definition of the list matcher.+(define $foldr+ (lambda [$fn $init $ls]+ (match ls (list something)+ {[<nil> init]+ [<cons $x $xs> (fn x (foldr fn init xs))]})))++(define $foldl+ (lambda [$fn $init $ls]+ (match ls (list something)+ {[<nil> init]+ [<cons $x $xs>+ (let {[$z (fn init x)]}+ (seq z (foldl fn z xs)))]})))++(define $scanl+ (lambda [$fn $init $ls]+ {init @(match ls (list something)+ {[<nil> {}]+ [<cons $x $xs> (scanl fn (fn init x) xs)]})}))++(define $append+ (lambda [$xs $ys]+ {@xs @ys}))++(define $concat+ (lambda [$xss]+ (foldr (lambda [$xs $rs] {@xs @rs})+ {}+ xss)))+ (define $reverse (lambda [$xs] (match xs (list something)@@ -349,9 +233,56 @@ (define $split/m (lambda [$a $in $ls] (match ls (list a)- {[<join $xs <join ,in $rs>> {xs @(split/m $a in rs)}]+ {[<join $xs <join ,in $rs>> {xs @(split/m a in rs)}] [_ {ls}]}))) +(define $find-cycle+ (lambda [$xs]+ (match xs (list something)+ {[<join $s <cons $x <join $c <cons ,x _>>>> [s {x @c}]]})))++(define $repeat+ (lambda [$xs]+ {@xs @(repeat xs)}))++(define $repeat1+ (lambda [$x]+ {x @(repeat1 x)}))++;;+;; Others+;;+(define $all+ (lambda [$pred $xs]+ (match xs (list something)+ {[<nil> #t]+ [<cons $x $rs>+ (if (pred x)+ (all pred rs)+ #f)]})))++(define $any+ (lambda [$pred $xs]+ (match xs (list something)+ {[<nil> #f]+ [<cons $x $rs>+ (if (pred x)+ #t+ (any pred rs))]})))++(define $from+ (lambda [$s]+ {s (+ s 1) (+ s 2) (+ s 3) (+ s 4) (+ s 5) (+ s 6) (+ s 7) (+ s 8) (+ s 9) (+ s 10) @(from (+ s 11))}))++; Note. `between` is used in the definition of the list matcher.+(define $between+ (lambda [$s $e]+ (if (eq? s e)+ {s}+ (if (lt? s e)+ {s @(between (+ s 1) e)}+ {}))))+ ;;; ;;; Multiset ;;;@@ -441,14 +372,14 @@ (define $union (lambda [$xs $ys]- {xs+ {@xs @(match-all [ys xs] [(multiset something) (multiset something)] [[<cons $y _> ^<cons ,y _>] y]) })) (define $union/m (lambda [$a $xs $ys]- {xs+ {@xs @(match-all [ys xs] [(multiset a) (multiset a)] [[<cons $y _> ^<cons ,y _>] y]) }))@@ -462,6 +393,50 @@ (lambda [$a $xs $ys] (match-all [xs ys] [(multiset a) (multiset a)] [[<cons $x _> <cons ,x _>] x])))++;;+;; Simple predicate+;;+(define $member?+ (lambda [$x $ys]+ (match ys (list something)+ {[<join _ <cons ,x _>> #t]+ [_ #f]})))++(define $member?/m+ (lambda [$a $x $ys]+ (match ys (list a)+ {[<join _ <cons ,x _>> #t]+ [_ #f]})))++;;+;; Counting+;;+(define $count+ (lambda [$x $xs]+ (foldl (match-lambda [something something]+ {[[$r ,x] (+ r 1)]+ [[$r $y] r]})+ 0+ xs)))++(define $count/m+ (lambda [$a $x $xs]+ (foldl (match-lambda [a a]+ {[[$r ,x] (+ r 1)]+ [[$r $y] r]})+ 0+ xs)))++(define $frequency+ (lambda [$xs]+ (let {[$us (unique xs)]}+ (map (lambda [$u] [u (count u xs)]) us))))++(define $frequency/m+ (lambda [$a $xs]+ (let {[$us (unique/m a xs)]}+ (map (lambda [$u] [u (count/m a u xs)]) us)))) ;;; ;;; Set
lib/core/number.egi view
@@ -44,6 +44,10 @@ })))]} {2 3 5 @(next-primes {2 3 5} 1)})) +(define $divisor?+ (lambda [$n $d]+ (eq? 0 (remainder n d))))+ (define $find-factor (lambda [$n] (match primes (list integer)@@ -57,39 +61,6 @@ (define $p-f prime-factorization) -(define $pfs (map (lambda [$n] [n (p-f n)]) nats))--(define $pfs-n- (lambda [$n]- (match-all pfs (list [integer (list integer)])- [<join _ <cons [$m (loop $i [1 n] <cons $p_i ...> <nil>)] _>> [m (map (lambda [$i] p_i) (between 1 n))]])))--(define $prime?- (lambda [$n]- (if (eq? n 1)- #f- (eq? (rac (while (lte? $ n) primes)) n))))--;;;-;;; Integers-;;;-(define $integer builtin-data-matcher)--(define $power- (lambda [$x $n]- (foldl * 1 (take n (repeat1 x)))))--(define $mod- (lambda [$m]- (matcher- {[,$n []- {[$tgt (if (eq? (modulo tgt m) (modulo n m))- {[]}- {})]}]- [$ [something]- {[$tgt {tgt}]}]- })))- (define $even? (lambda [$n] (eq? 0 (modulo n 2))))@@ -98,33 +69,11 @@ (lambda [$n] (eq? 1 (modulo n 2)))) -(define $between?- (lambda [$m $n $x]- (and (lte? m x) (lte? x n))))--(define $sum- (lambda [$xs]- (foldl + 0 xs)))--(define $product- (lambda [$xs]- (foldl * 1 xs)))--(define $fib+(define $prime? (lambda [$n]- (letrec {[$fib1 (lambda [$n $ret1 $ret2]- (match n nat- {[<o> ret2]- [<s <o>> ret1]- [<s $n1> (fib1 (- n 1) (+ ret1 ret2) ret1)]- }))]}- (fib1 n 1 1))))--(define $fibs (map fib nats0))--(define $divisor?- (lambda [$n $d]- (eq? 0 (remainder n d))))+ (if (eq? n 1)+ #f+ (eq? (rac (while (lte? $ n) primes)) n)))) (define $gcd (lambda [$ns]@@ -147,10 +96,31 @@ (fact r)))) ;;;-;;; Float Numbers+;;; Integers ;;;-(define $float builtin-data-matcher)+(define $mod+ (lambda [$m]+ (matcher+ {[,$n []+ {[$tgt (if (eq? (modulo tgt m) (modulo n m))+ {[]}+ {})]}]+ [$ [something]+ {[$tgt {tgt}]}]+ }))) +(define $power+ (lambda [$x $n]+ (foldl * 1 (take n (repeat1 x)))))++(define $sum+ (lambda [$xs]+ (foldl + 0 xs)))++(define $product+ (lambda [$xs]+ (foldl * 1 xs)))+ ;;; ;;; Decimal Fractions ;;;@@ -169,7 +139,7 @@ [$n (denominator x)] [$q (quotient m n)] [$r (remainder m n)]}- <Df q (map (lambda [$x $y] x) (rtod-helper r n))>)))+ <Df q (map fst (rtod-helper r n))>))) (define $rtod' (lambda [$x]@@ -178,7 +148,7 @@ [$q (quotient m n)] [$r (remainder m n)] [[$s $c] (find-cycle (rtod-helper r n))]}- <Df' q (map (lambda [$x $y] x) s) (map fst c)>)))+ <Df' q (map fst s) (map fst c)>))) (define $show-decimal (lambda [$n $x]
lib/core/order.egi view
@@ -29,32 +29,50 @@ (foldl (lambda [$ret $x] (match ret [integer integer] {[[$min $max] (if (lt? x min) [x max]- (if (gt? x max) [min x]+ (if (gt? x min) [min x] [min max]))]})) [(car ns) (car ns)] (cdr ns)))) -(define $split-by-ordering (split-by-ordering/f compare $ $))+(define $min/fn+ (lambda [$compare $ns]+ (foldl 2#(if (eq? (compare %1 %2) <Less>) %1 %2) (car ns) (cdr ns)))) -(define $split-by-ordering/f+(define $max/fn+ (lambda [$compare $ns]+ (foldl 2#(if (eq? (compare %1 %2) <Greater>) %1 %2) (car ns) (cdr ns))))++(define $min-and-max/fn+ (lambda [$compare $ns]+ (foldl (lambda [$ret $x]+ (match ret [integer integer]+ {[[$min $max] (if (eq? (compare x min) <Less>) [x max]+ (if (eq? (compare x min) <Greater>) [min x]+ [min max]))]}))+ [(car ns) (car ns)]+ (cdr ns))))++(define $split-by-ordering (split-by-ordering/fn compare $ $))++(define $split-by-ordering/fn (lambda [$f $p $xs] (match xs (list something) {[<nil> [{} {} {}]] [<cons $x $rs>- (let {[[$ys1 $ys2 $ys3] (split-by-ordering/f f p rs)]}+ (let {[[$ys1 $ys2 $ys3] (split-by-ordering/fn f p rs)]} (match (f x p) ordering {[<less> [{x @ys1} ys2 ys3]] [<equal> [ys1 {x @ys2} ys3]] [<greater> [ys1 ys2 {x @ys3}]]}))]}))) -(define $qsort (qsort/f compare $))+(define $qsort (qsort/fn compare $)) -(define $qsort/f+(define $qsort/fn (lambda [$f $xs] (match xs (list something) {[<nil> {}] [<cons $x <nil>> {x}] [_ (let* {[$n (length xs)] [$p (nth (quotient n 2) xs)]- [[$ys1 $ys2 $ys3] (split-by-ordering/f f p xs)]}- {@(qsort/f f ys1) @ys2 @(qsort/f f ys3)})]})))+ [[$ys1 $ys2 $ys3] (split-by-ordering/fn f p xs)]}+ {@(qsort/fn f ys1) @ys2 @(qsort/fn f ys3)})]})))
lib/core/random.egi view
@@ -52,6 +52,8 @@ (car (match-all xs (R.multiset something) [<cons $x $rs> rs])))) +(define $sample R.car)+ (define $R.set (lambda [$a] (matcher
lib/core/string.egi view
@@ -35,16 +35,9 @@ {[$tgt {tgt}]}] })) -(define $chop- (lambda [$xs]- (match xs string- {[<snoc (| ,'\n' ,' ') $ys> (chop ys)]- [_ xs]})))- ;;;-;;; String as Collection+;;; String as collection ;;;- (define $S.empty? (lambda [$xs] (eq? xs "")))@@ -83,6 +76,9 @@ (define $S.intercalate (compose intersperse S.concat)) +;;+;; Alphabet+;; (define $alphabet? (match-lambda char {[,'a' #t] [,'b' #t] [,'c' #t] [,'d' #t] [,'e' #t]
+ sample/triangle.egi view
@@ -0,0 +1,26 @@+(define $points+ {[3 1] [4 5] [7 7] [8 1] [1 9] [3 8] [3 1]})++(define $on-a-line?+ (match-lambda [[integer integer] [integer integer] [integer integer]]+ {[[[$x1 $y1] [$x2 $y2] [$x3 $y3]]+ (eq? (abs (* (- y2 y1) (- x3 x1)))+ (abs (* (- y3 y1) (- x2 x1))))]}))++; Enumerate triangles+(match-all points (list [integer integer])+ [<join _ <cons $p1+ <join _ <cons $p2+ <join _ <cons (& ^?(on-a-line? p1 p2 $) $p3)+ _>>>>>>+ [p1 p2 p3]])+;=>{[[3 1] [4 5] [7 7]] [[3 1] [4 5] [8 1]] [[3 1] [7 7] [8 1]] [[4 5] [7 7] [8 1]] [[3 1] [7 7] [1 9]] [[3 1] [8 1] [1 9]] [[4 5] [7 7] [1 9]] [[4 5] [8 1] [1 9]] [[7 7] [8 1] [1 9]] [[3 1] [4 5] [3 8]] [[3 1] [7 7] [3 8]] [[3 1] [8 1] [3 8]] [[3 1] [1 9] [3 8]] [[4 5] [7 7] [3 8]] [[4 5] [8 1] [3 8]] [[4 5] [1 9] [3 8]] [[7 7] [8 1] [3 8]] [[7 7] [1 9] [3 8]] [[8 1] [1 9] [3 8]] [[4 5] [7 7] [3 1]] [[4 5] [8 1] [3 1]] [[4 5] [1 9] [3 1]] [[4 5] [3 8] [3 1]] [[7 7] [8 1] [3 1]] [[7 7] [1 9] [3 1]] [[7 7] [3 8] [3 1]] [[8 1] [1 9] [3 1]] [[8 1] [3 8] [3 1]] [[1 9] [3 8] [3 1]]}++; Enumerate tiplets of points on a line+(match-all points (list [integer integer])+ [<join _ <cons $p1+ <join _ <cons $p2+ <join _ <cons (& ?(on-a-line? p1 p2 $) $p3)+ _>>>>>>+ [p1 p2 p3]])+;=>{[[3 1] [4 5] [1 9]] [[3 1] [4 5] [3 1]] [[3 1] [7 7] [3 1]] [[3 1] [8 1] [3 1]] [[3 1] [1 9] [3 1]] [[3 1] [3 8] [3 1]]}