egison 3.5.1 → 3.5.2

raw patch · 12 files changed

+231/−88 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• egison.cabal +1/−1
• elisp/egison-mode.el +6/−0
• hs-src/Language/Egison.hs +1/−1
• hs-src/Language/Egison/Types.hs +1/−0
• lib/core/base.egi +7/−5
• lib/core/collection.egi +24/−24
• lib/core/io.egi +0/−7
• lib/core/math.egi +0/−18
• lib/core/number.egi +59/−24
• lib/core/random.egi +69/−0
• sample/3sat.egi +40/−0
• sample/pi.egi +23/−8

@@ -1,5 +1,5 @@ Name:                egison-Version:             3.5.1+Version:             3.5.2 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.

@@ -48,6 +48,7 @@       "\\<do\\>"      "\\<io\\>"+     "\\<seq\\>"       "\\<undefined\\>"      "\\<something\\>"@@ -59,6 +60,9 @@      "\\\&"      "@"      "\\<_\\>"++     "\\<assert\\>"+     "\\<assert-equal\\>"      ))   "Subdued expressions to highlight in Egison modes.") @@ -160,6 +164,8 @@         ((equal "pattern-function" name) 2)         ((equal "do" name) 2)         ((equal "io" name) 2)+        ((equal "assert" name) 2)+        ((equal "assert-equal" name) 2)         ))  (defun egison-indent-line ()

@@ -109,7 +109,7 @@   , "lib/core/collection.egi"   , "lib/core/order.egi"   , "lib/core/number.egi"-  , "lib/core/math.egi"   , "lib/core/io.egi"+  , "lib/core/random.egi"   , "lib/core/string.egi"   ]

@@ -295,6 +295,7 @@  (String str) == (String str') = str == str'  (Bool b) == (Bool b') = b == b'  (Integer i) == (Integer i') = i == i'+ (Rational r) == (Rational r') = r == r'  (Float f) == (Float f') = f == f'  (InductiveData name vals) == (InductiveData name' vals') = name == name' && vals == vals'  (Tuple vals) == (Tuple vals') = vals == vals'

@@ -14,11 +14,7 @@       {[$tgt {tgt}]}]      }))   -(define $id (lambda [$x] x))--(define $fst (lambda [$x $y] x))--(define $snd (lambda [$x $y] y))(define $bool builtin-data-matcher)+(define $bool builtin-data-matcher)  (define $or   (lambda [$b1 $b2]@@ -45,6 +41,12 @@     (match x a       {[,y #t]        [_ #f]})))++(define $id (lambda [$x] x))++(define $fst (lambda [$x $y] x))++(define $snd (lambda [$x $y] y))  (define $compose   (lambda [$f $g]

@@ -30,7 +30,7 @@                                                          rs]])]}]        [<nioj $ $> [(list a) (list a)]         {[$tgt (match-all tgt (list a)-                 [(loop $i [1 $n] <snoc $xa_i ...> $rs) [(foldr (lambda [$i $r] {xa_i @r}) {} (between 1 n))+                 [(loop $i [1 $n] <snoc $xa_i ...> $rs) [(foldr (lambda [$i $r] {@r xa_i}) {} (between 1 n))                                                          rs]])]}]        [$ [something]         {[$tgt {tgt}]}]@@ -83,12 +83,6 @@ ;; ;; Helper function for List matcher, be careful for recursive calls ;;-(define $map-  (lambda [$fn $xs]-    (match xs (list something)-      {[<nil> {}]-       [<cons $x $rs> {(fn x) @(map fn rs)}]})))- (define $between   (lambda [$s $e]     (if (eq? s e)@@ -101,23 +95,15 @@   (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))})) -;;-;; list functions-;;-(define $repeat1-  (lambda [$x]-    {x @(repeat1 x)}))--(define $repeat-  (lambda [$xs]-    {@xs @(repeat xs)}))- (define $foldr   (lambda [$fn $init $ls]     (match ls (list something)       {[<nil> init]        [<cons $x $xs> (fn x (foldr fn init xs))]}))) +;;+;; list functions+;; (define $foldl foldl')  (define $foldl'@@ -128,6 +114,26 @@         (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))@@ -152,12 +158,6 @@     (foldr (lambda [$xs $rs] {@xs @rs})            {}            xss)))--(define $scanl-  (lambda [$fn $init $ls]-    {init @(match ls (list something)-             {[<nil> {}]-              [<cons $x $xs> (scanl fn (fn init x) xs)]})}))  (define $map2   (lambda [$fn $xs $ys]

@@ -48,10 +48,3 @@        [<cons $x $rs>         (do {[(proc x)]}           (each proc rs))]})))--;;;-;;; Others-;;;-(define $pure-rand-  (lambda [$s $e]-    (io (rand s e))))

@@ -1,18 +0,0 @@-;;;;;-;;;;;-;;;;; Math-;;;;;-;;;;;--(define $fact-  (lambda [$n]-    (foldl * 1 (between 1 n))))--(define $perm-  (lambda [$n $r]-    (foldl * 1 (between (- n (- r 1)) n))))--(define $comb-  (lambda [$n $r]-    (/ (perm n r)-       (fact r))))

@@ -22,35 +22,13 @@       {[$tgt {tgt}]}]      })) -(define $fib-  (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 $divisor?-  (lambda [$n $d]-    (eq? 0 (remainder n d))))--(define $gcd-  (lambda [$ns]-    (match ns (multiset integer)-      {[<cons $n <nil>> n]-       [<cons (& ,(min ns) $m) $rs>-        (gcd {m @((remove-all integer) (map (lambda [$r] (modulo r m)) rs)-                                       0)})]})))- (define $nats {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 @(map (+ 100 $) nats)})  (define $nats0 {0 @nats})  (define $odds {1 @(map (+ $ 2) odds)}) -(define $evens {2 @(map (+ $ 2) odds)})+(define $evens {2 @(map (+ $ 2) evens)})  (define $primes   (letrec {[$next-primes@@ -83,7 +61,7 @@  (define $pfs-n   (lambda [$n]-    (match-all p-fs (list [integer (list integer)])+    (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?@@ -128,6 +106,46 @@   (lambda [$xs]     (foldl + 0 xs))) +(define $product+  (lambda [$xs]+    (foldl * 1 xs)))++(define $fib+  (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))))++(define $gcd+  (lambda [$ns]+    (match ns (multiset integer)+      {[<cons $n <nil>> n]+       [<cons (& ,(min ns) $m) $rs>+        (gcd {m @(delete 0 (map (lambda [$r] (modulo r m)) rs))})]})))++(define $fact+  (lambda [$n]+    (foldl * 1 (between 1 n))))++(define $perm+  (lambda [$n $r]+    (foldl * 1 (between (- n (- r 1)) n))))++(define $comb+  (lambda [$n $r]+    (/ (perm n r)+       (fact r))))+ ;;; ;;; Float Numbers ;;;@@ -172,3 +190,20 @@   (lambda [$x]     (match (rtod' x) decimal'       {[<df' $q $s $c> (foldl S.append "" {(S.append (show q) ".") @(map show s) " " @(map show c) " ..."})]})))++;;;+;;; Continued Fraction+;;;+(define $regular-continued-fraction+  (lambda [$as]+    (+ (car as)+       (foldr (lambda [$a $r] (/ 1 (+ a r)))+              0+              (cdr as)))))+++(define $continued-fraction+  (match-lambda [(list integer) (list integer)]+    {[[<cons $a $as> <cons $b $bs>]+      (+ a (/ b (continued-fraction as bs)))]+     [[<cons $a <nil>> <nil>] a]}))

@@ -0,0 +1,69 @@+;;;;;+;;;;; Random+;;;;;++(define $pure-rand+  (lambda [$s $e]+    (io (rand s e))))++(define $randomize+  (lambda [$xs]+    (letrec {[$randomize'+              (lambda [$xs $n]+                (if (eq? n 0)+                  {}+                  (let {[$r (pure-rand 1 n)]}+                    (let {[$x (nth r xs)]}+                    {x @(randomize' (delete-first x xs) (- n 1))}))))]}+      (randomize' xs (length xs)))))    ++(define $R.between+  (lambda [$s $e]+    (randomize (between s e))))++(define $R.multiset+  (lambda [$a]+    (matcher+      {[<nil> []+        {[{} {[]}]+         [_ {}]}]+       [<cons $ $> [a (R.multiset a)]+        {[$tgt (map (lambda [$i]+                      (match tgt (list a)+                        {[(loop $j [1 (- i 1)] <cons $xa_j ...> <cons $x $ts>)+                          [x {@(map (lambda [$j] xa_j) (between 1 (- i 1))) @ts}]]}))+                    (R.between 1 (length tgt)))]}]+       [$ [something]+        {[$tgt {tgt}]}]+       })))++(define $R.uncons+  (lambda [$xs]+    (car (match-all xs (R.multiset something)+           [<cons $x $rs> [x rs]]))))++(define $R.car+  (lambda [$xs]+    (car (match-all xs (R.multiset something)+           [<cons $x $rs> x]))))++(define $R.cdr+  (lambda [$xs]+    (car (match-all xs (R.multiset something)+           [<cons $x $rs> rs]))))++(define $R.set+  (lambda [$a]+    (matcher+      {[<nil> []+        {[{} {[]}]+         [_ {}]}]+       [<cons $ $> [a (R.multiset a)]+        {[$tgt (map (lambda [$i]+                      (match tgt (list a)+                        {[(loop $j [1 (- i 1)] <cons _ ...> <cons $x _>)+                          [x tgt]]}))+                    (R.between 1 (length tgt)))]}]+       [$ [something]+        {[$tgt {tgt}]}]+       })))

@@ -0,0 +1,40 @@+;;;+;;; Randomized 3-SAT+;;;++(define $clause-satisfy?+  (lambda [$c $a]+    (any (lambda [$i $b] (if b a_i (not a_i))) c)))++(define $random-assign+  (lambda [$n]+    (generate-array [$i] n (R.car {#t #f}))))++(define $random-walk-3sat+  (match-lambda [something integer integer integer something]+    {[[$f _ ,0 ,0 _] <Nothing>]+     [[$f $n ,0 $r _] (random-walk-3sat f n (* n 3) (- r 1) (random-assign n))]+     [[$f $n $k $r $a]+      (match (randomize f) (multiset (R.multiset [integer bool]))+        {[<cons (& ^?(clause-satisfy? $ a) <cons [$x _] _>) _>+          (random-walk-3sat f n (- k 1) r (generate-array [$i] n (if (eq? i x) (not a_i) a_i)))]+         [_ <Just a>]})]}))++(define $R.sat-solver+  (lambda [$f $n $r]+    (random-walk-3sat f n (* 3 n) r (random-assign n))))++(define $c1 {[1 #t] [2 #t] [3 #t]})+(define $c2 {[4 #t] [2 #t] [3 #f]})+(define $c3 {[1 #f] [4 #t] [3 #t]})+(define $c4 {[1 #f] [4 #f] [2 #t]})+(define $c5 {[4 #f] [2 #f] [3 #t]})+(define $c6 {[1 #f] [2 #f] [3 #f]})+(define $c7 {[1 #t] [4 #f] [3 #f]})+(define $c8 {[1 #t] [4 #t] [2 #f]})++(define $p1 {c1 c2 c3 c4 c5 c6 c7 c8})+(define $p2 {c1 c2 c3 c4 c5 c6 c8})++(R.sat-solver p1 4 3)+(R.sat-solver p2 4 3)

@@ -9,15 +9,30 @@                  0                  (take n nats)))))) +(test (pi 1))+(test (pi 2))+(test (pi 3))+(test (pi 4)) (test (pi 5))-(test (rtod' (pi 5)))-(test (show-decimal' (pi 5))) (test (pi 6))-(test (rtod' (pi 6)))-(test (show-decimal' (pi 6))) (test (pi 7))-(test (show-decimal 10 (pi 7)))-(test (pi 100))-(test (rtof (pi 100)))-(test (show-decimal 100 (pi 100)))+(test (pi 8))+(test (pi 9))+(test (pi 10))+(test (pi 20))+(test (pi 200)) +(test (show-decimal 100 (pi 1)))+(test (show-decimal 100 (pi 2)))+(test (show-decimal 100 (pi 3)))+(test (show-decimal 100 (pi 4)))+(test (show-decimal 100 (pi 5)))+(test (show-decimal 100 (pi 6)))+(test (show-decimal 100 (pi 7)))+(test (show-decimal 100 (pi 8)))+(test (show-decimal 100 (pi 9)))+(test (show-decimal 100 (pi 10)))+(test (show-decimal 100 (pi 20)))+(test (show-decimal 100 (pi 200)))++(test (show (rtof (pi 200))))