egison 0.3.0.2 → 0.3.0.3
raw patch · 7 files changed
+173/−75 lines, 7 files
Files
- Egison.hs +1/−1
- egison.cabal +3/−3
- etc/lib/base.egi +5/−10
- etc/lib/collection.egi +18/−38
- etc/lib/number.egi +5/−7
- etc/lib/poker-hands.egi +124/−0
- etc/sample/collection-test.egi +17/−16
Egison.hs view
@@ -9,7 +9,7 @@ import IO hiding (try) welcomeMsg :: String-welcomeMsg = "Egison, version 0.3.0.2 : http://hagi.is.s.u-tokyo.ac.jp/~egi/egison/\nWelcome to Egison Interpreter!\n"+welcomeMsg = "Egison, version 0.3.0.3 : http://hagi.is.s.u-tokyo.ac.jp/~egi/egison/\nWelcome to Egison Interpreter!\n" byebyeMsg :: String byebyeMsg = "\nLeaving Egison.\nByebye. See you again! (^^)/\n"
egison.cabal view
@@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version: 0.3.0.2+Version: 0.3.0.3 -- A short (one-line) description of the package. Synopsis: An Interpreter for the Programming Language Egison@@ -15,7 +15,7 @@ -- A longer description of the package. Description: An interpreter for the programming language Egison. A feature of Egison is the strong pattern match facility.- With Egison, you can represent pattern matching for non-inductive data intuitively,+ With Egison, you can represent pattern matching for unfree data intuitively, especially for collection data, such as lists, multisets, sets, and so on. This package include sample Egison program codes "*-test.egi" in "etc/sample/" directory. This package also include Emacs Lisp file "egison-mode.el" in "etc/elisp/" directory.@@ -45,7 +45,7 @@ Data-Dir: etc/ -Data-files: lib/base.egi lib/number.egi lib/collection.egi sample/number-test.egi sample/collection-test.egi sample/io-test.egi elisp/egison-mode.el+Data-files: lib/base.egi lib/number.egi lib/collection.egi lib/poker-hands.egi sample/number-test.egi sample/collection-test.egi sample/io-test.egi elisp/egison-mode.el -- Extra files to be distributed with the package, such as examples or -- a README.
etc/lib/base.egi view
@@ -1,7 +1,6 @@ (define $Something (type- {[$var-match (lambda [$tgt] {tgt})]- }))+ {[$var-match (lambda [$tgt] {tgt})]})) (define $Bool (type@@ -13,15 +12,13 @@ [_ {}]}] [false [] {[<false> {[]}]- [_ {}]}]- })]+ [_ {}]}]})] [$equal? (lambda [$val $tgt] (match [val tgt] [Bool Bool] {[[<true> <true>] <true>] [[<false> <false>] <true>]- [[_ _] <false>]}))]- }))+ [[_ _] <false>]}))]})) (define $or (lambda [$b1 $b2]@@ -54,13 +51,11 @@ [_ {}]}] [greater [] {[<greater> {[]}]- [_ {}]}]- })]+ [_ {}]}]})] [$equal? (lambda [$val $tgt] (match [val tgt] [Order Order] {[[<less> <less>] <true>] [[<equal> <equal>] <true>] [[<greater> <greater>] <true>]- [[_ _] <false>]}))]- }))+ [[_ _] <false>]}))]}))
etc/lib/collection.egi view
@@ -6,16 +6,13 @@ (deconstructor {[nil [] {[{} {[]}]- [_ {}]- }]+ [_ {}]}] [cons [a (List a)] {[{$x .$xs} {[x xs]}]- [_ {}]- }]+ [_ {}]}] [snoc [a (List a)] {[{.$xs $x} {[x xs]}]- [_ {}]- }]+ [_ {}]}] [join [(List a) (List a)] {[$tgt (let {[$loop (lambda [$ts]@@ -26,8 +23,7 @@ @(map (lambda [$as $bs] [{x @as} bs]) (loop xs))}]}))]}- (loop tgt))]- }]+ (loop tgt))]}] [nioj [(List a) (List a)] {[$tgt (let {[$loop (lambda [$ts]@@ -38,17 +34,12 @@ @(map (lambda [$as $bs] [{@as x} bs]) (loop xs))}]}))]}- (loop tgt))]- }]- })]+ (loop tgt))]}]})] [$equal? (lambda [$val $tgt] (match [val tgt] [(List a) (List a)] {[[<nil> <nil>] <true>]- [[<cons $x $xs>- <cons ,x ,xs>]- <true>]- [[_ _] <false>]}))]- })))+ [[<cons $x $xs> <cons ,x ,xs>] <true>]+ [[_ _] <false>]}))]}))) (define $map (lambda [$fn $ls]@@ -100,8 +91,7 @@ [<cons $x $rs> (let {[$subs (subcollections rs)]} {@subs @(map (lambda [$sub] {x @sub})- subs)})]- })))+ subs)})]}))) (define $car (lambda [$xs]@@ -121,8 +111,7 @@ (match ys (List a) {[<nil> <false>] [<cons ,x $ys> <true>]- [<cons $y $ys> ((member? a) x ys)]- }))))+ [<cons $y $ys> ((member? a) x ys)]})))) (define $unique (lambda [$a]@@ -134,8 +123,7 @@ (match ((member? a) x ys) Bool {[<true> (loop rs ys)] [<false> (loop rs {@ys x})]- [_ {}]- })]}))]}+ [_ {}]})]}))]} (loop xs {}))))) (define $subcollection?@@ -162,25 +150,18 @@ (deconstructor {[nil [] {[{} {[]}]- [_ {}]- }]+ [_ {}]}] [cons [a (Multiset a)] {[$tgt (map (lambda [$t] [t ((remove a) tgt t)])- tgt)]- }]+ tgt)]}] [join [(Multiset a) (Multiset a)] {[$tgt (map (lambda [$ts] [ts ((remove-collection a) tgt ts)])- (subcollections tgt))]- }]- })]+ (subcollections tgt))]}]})] [$equal? (lambda [$val $tgt] (match [val tgt] [(Multiset a) (Multiset a)] {[[<nil> <nil>] <true>]- [[<cons $x $xs>- <cons ,x ,xs>]- <true>]- [[_ _] <false>]}))]- })))+ [[<cons $x $xs> <cons ,x ,xs>] <true>]+ [[_ _] <false>]}))]}))) (define $Set (lambda [$a]@@ -199,7 +180,6 @@ {[$tgt (let {[$tgt2 ((unique a) tgt)]} (concat (map (lambda [$xs $ys] (map (lambda [$sxs] [xs {@ys @sxs}]) (subcollections xs)))- (match-all tgt2 (Multiset a) [<join $xs $ys> [xs ys]]))))]}]- })]- [$equal? (lambda [$val $tgt] (and ((subcollection? a) val tgt) ((subcollection? a) tgt val)))]- })))+ (match-all tgt2 (Multiset a) [<join $xs $ys> [xs ys]]))))]}]})]+ [$equal? (lambda [$val $tgt]+ (and ((subcollection? a) val tgt) ((subcollection? a) tgt val)))]})))
etc/lib/number.egi view
@@ -4,6 +4,8 @@ [$equal? (lambda [$val $tgt] (= val tgt))]})) +(define $Int Number)+ (define $Nat (type {[$var-match (lambda [$tgt] {tgt})]@@ -11,15 +13,11 @@ (deconstructor {[o [] {[0 {[]}]- [_ {}]- }]+ [_ {}]}] [s [Nat] {[$tgt (match (compare-number tgt 0) Order {[<greater> {(- tgt 1)}]- [_ {}]})]- }]- })]+ [_ {}]})]}]})] [$equal? (lambda [$val $tgt]- (= val tgt))]- }))+ (= val tgt))]}))
+ etc/lib/poker-hands.egi view
@@ -0,0 +1,124 @@+(define $Suit+ (type+ {[$var-match (lambda [$tgt] {tgt})]+ [$inductive-match+ (deconstructor+ {[spade []+ {[<spade> {[]}]+ [_ {}]}]+ [heart []+ {[<heart> {[]}]+ [_ {}]}]+ [club []+ {[<club> {[]}]+ [_ {}]}]+ [diamond []+ {[<diamond> {[]}]+ [_ {}]}]+ })]+ [$equal?+ (lambda [$val $tgt]+ (match [val tgt] [Suit Suit]+ {[[<spade> <spade>] <true>]+ [[<heart> <heart>] <true>]+ [[<club> <club>] <true>]+ [[<diamond> <diamond>] <true>]+ [[_ _] <false>]}))]+ }))++(define $Mod+ (lambda [$m]+ (type+ {[$var-match (lambda [$tgt] {(mod tgt m)})]+ [$equal? (lambda [$val $tgt]+ (= (mod val m) (mod tgt m)))]})))++(define $Card+ (type+ {[$var-match (lambda [$tgt] {tgt})]+ [$inductive-match+ (deconstructor+ {[card [Suit (Mod 13)]+ {[<card $s $n> {[s n]}]}]})]+ [$equal? (lambda [$val $tgt]+ (match [val tgt] [Card Card]+ {[[<card $s $n>+ <card ,s ,n>]+ <true>]+ [[_ _] <false>]}))]}))++(define $poker-hands+ (lambda [$Cs]+ (match Cs (Multiset Card)+ {[<cons <card $S $n>+ <cons <card ,S ,(- n 1)>+ <cons <card ,S ,(- n 2)>+ <cons <card ,S ,(- n 3)>+ <cons <card ,S ,(- n 4)>+ !<nil>+ >>>>>+ <straight-flush>]+ [<cons <card _ $n>+ <cons <card _ ,n>+ !<cons <card _ ,n>+ !<cons <card _ ,n>+ !<cons _+ !<nil>+ >>>>>+ <four-of-kind>]+ [<cons <card _ $m>+ <cons <card _ ,m>+ <cons <card _ ,m>+ !<cons <card _ $n>+ !<cons <card _ ,n>+ !<nil>+ >>>>>+ <full-house>]+ [<cons <card $S _>+ !<cons <card ,S _>+ !<cons <card ,S _>+ !<cons <card ,S _>+ !<cons <card ,S _>+ !<nil>+ >>>>>+ <flush>]+ [<cons <card _ $n>+ <cons <card _ ,(- n 1)>+ <cons <card _ ,(- n 2)>+ <cons <card _ ,(- n 3)>+ <cons <card _ ,(- n 4)>+ !<nil>+ >>>>>+ <straight>]+ [<cons <card _ $n>+ <cons <card _ ,n>+ <cons <card _ ,n>+ <cons _+ <cons _+ !<nil>+ >>>>>+ <three-of-kind>]+ [<cons <card _ $m>+ <cons <card _ ,m>+ !<cons <card _ $n>+ <cons <card _ ,n>+ !<cons _+ !<nil>+ >>>>>+ <two-pair>]+ [<cons <card _ $n>+ <cons <card _ ,n>+ <cons _+ <cons _+ <cons _+ !<nil>+ >>>>>+ <one-pair>]+ [<cons _+ <cons _+ <cons _+ <cons _+ <cons _+ !<nil>+ >>>>>+ <nothing>]})))
etc/sample/collection-test.egi view
@@ -55,8 +55,7 @@ <cons <card ,S ,(- n 2)> <cons <card ,S ,(- n 3)> <cons <card ,S ,(- n 4)>- !<nil>- >>>>>+ <nil>>>>>> <straight-flush>] [<cons <card _ $n> <cons <card _ ,n>@@ -123,23 +122,12 @@ >>>>> <nothing>]}))) -(define $ham1- (lambda [$xs $ys]- (match [xs ys] [(List Bool) (List Bool)]- {[[<join $hs <cons $x $ts>>- <join ,hs <cons ,(not x) ,ts>>]- <true>]- [[_ _] <false>]}))) --(test (match-all {1 2 3} (Multiset Number)- [<cons $x <cons $y <cons $z <nil>>>> [x y z]]))- (test (match-all {{1 2 3} {4 5 1} {6 1 7}} (List (Multiset Number)) [<cons <cons $x _>- <cons <cons $y _>- <cons <cons $z _>- <nil>>>>+ <cons <cons $y _>+ <cons <cons $z _>+ <nil>>>> [x y z]])) (test (match-all {{1 2 3} {4 5 1} {6 1 7}} (List (Multiset Number))@@ -284,3 +272,16 @@ (test (match-all {1 2 3 4} (Stick Number) [<join $xs <cons $w $ys>> [xs w ys]])) (test (match-all {1 2 3} (Stick Number) [,{3 2 1} <ok>])) ++(match {2 7 7 2 7} (Multiset Number)+ {[<cons $m+ <cons ,m+ <cons ,m+ $tmp1>>>+ (match tmp1 (Multiset Number)+ {[<cons $n $tmp2>+ (match tmp2 (Multiset Number)+ {[<cons ,n $tmp3>+ (match tmp3 (Multiset Number)+ {[<nil> <ok>]})]})]})]+ [_ <ko>]})