egison 3.2.3 → 3.2.4

raw patch · 9 files changed

+186/−108 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• egison.cabal +3/−3
• hs-src/Language/Egison.hs +2/−0
• hs-src/Language/Egison/Core.hs +9/−9
• lib/core/base.egi +0/−4
• lib/core/collection.egi +25/−20
• lib/core/natural-number.egi +88/−0
• lib/core/number.egi +27/−71
• lib/core/order.egi +31/−0

@@ -1,4 +1,4 @@-Copyright (c) 2011, Satoshi Egi+Copyright (c) 2011-2014, Satoshi Egi  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"),

@@ -1,6 +1,6 @@ Name:                egison-Version:             3.2.3-Synopsis:            The programming language with non-linear pattern-matching against unfree data+Version:             3.2.4+Synopsis:            Programming language with non-linear pattern-matching against unfree data types Description:         An interpreter for Egison, the programming langugage that realized non-linear pattern-matching with unfree data types.                      With Egison, you can represent pattern-matching with unfree data types intuitively,                      especially for collection data, such as lists, multisets, sets.@@ -17,7 +17,7 @@  Extra-Source-Files:  benchmark/Benchmark.hs -Data-files:          lib/core/base.egi lib/core/number.egi lib/core/collection.egi+Data-files:          lib/core/base.egi lib/core/collection.egi lib/core/order.egi lib/core/number.egi lib/core/natural-number.egi                      lib/tree/xml.egi lib/math/prime.egi                      elisp/egison-mode.el 

@@ -65,7 +65,9 @@     libraries :: [String]     libraries = [ "lib/core/base.egi"                 , "lib/core/collection.egi"+                , "lib/core/order.egi"                 , "lib/core/number.egi"+                , "lib/core/natural-number.egi"                  ]  fromEgisonM :: EgisonM a -> IO (Either EgisonError a)

@@ -502,7 +502,14 @@          >>= (\b -> return $ msingleton $ MState env loops (b ++ bindings) ((MAtom pattern target matcher):trees))     _ ->       case matcher of-        Value Something -> +        Value (Matcher matcher) -> do+          (patterns, targetss, matchers) <- inductiveMatch env' pattern target matcher+          mfor targetss $ \ref -> do+            targets <- evalRef ref >>= fromTuple+            let trees' = zipWith3 MAtom patterns targets matchers ++ trees+            return $ MState env loops bindings trees'+            +        _ -> -- Value Something -> -- for tupple patterns           case pattern of             WildCard -> return $ msingleton $ MState env loops bindings trees              PatVar name -> return $ msingleton $ MState env loops ((name, target):bindings) trees@@ -540,16 +547,9 @@                                          | otherwise = (k', v'):(subst k nv xs)                 subst _ _ [] = []             IndexedPat pattern indices -> throwError $ strMsg ("invalid indexed-pattern: " ++ show pattern) -                         _ -> throwError $ strMsg "something can only match with a pattern variable" -        Value (Matcher matcher) -> do-          (patterns, targetss, matchers) <- inductiveMatch env' pattern target matcher-          mfor targetss $ \ref -> do-            targets <- evalRef ref >>= fromTuple-            let trees' = zipWith3 MAtom patterns targets matchers ++ trees-            return $ MState env loops bindings trees'-        _ -> throwError $ TypeMismatch "matcher" matcher+--        _ -> throwError $ TypeMismatch "matcher" matcher processMState' (MState env loops bindings ((MNode penv (MState _ _ _ [])):trees)) =   return $ msingleton $ MState env loops bindings trees processMState' (MState env loops bindings ((MNode penv state@(MState env' loops' bindings' (tree:trees')):trees))) = do

@@ -40,10 +40,6 @@       {[$tgt {tgt}]}]      })) -(define $ordering-  (algebraic-data-matcher -    {<less> <equal> <greater>}))- (define $match?   (lambda [$a]     (lambda [$x $y]

@@ -53,11 +53,11 @@       {[<nil> {}]        [<cons $x $xs> {(fn x) @(map fn xs)}]}))) -(define $map-and-concat-  (lambda [$fn $ls]-    (match ls (list something)+(define $concat+  (lambda [$xss]+    (match xss (list something)       {[<nil> {}]-       [<cons $x $xs> {@(fn x) @(map-and-concat fn xs)}]})))+       [<cons $xs $rss> {@xs @(concat rss)}]})))  (define $foldr   (lambda [$fn $init $ls]@@ -120,13 +120,6 @@           xs           {@xs x})))) -(define $union-  (lambda [$a]-    (lambda [$xs $ys]-      (match ys (list something)-        {[<nil> xs]-         [<cons $y $rs> ((union a) ((add a) xs y) rs)]}))))- (define $occurrence   (lambda [$a]     (lambda [$xs]@@ -179,9 +172,12 @@       {[<snoc _ $ys> ys]})))  (define $nth-  (lambda [$i $l]-    (match l (list something)-      {[<cons $x $xs> (if (eq? i 0) x (nth (- i 1) xs))]})))+  (lambda [$n $xs]+    (match xs (list something)+      {[(loop $i [1 ,(- n 1)]+          <cons _ ...>+          <cons $x _>)+        x]})))  (define $take   (lambda [$n $xs]@@ -246,12 +242,6 @@               ((subcollection? a) rest ys)               #f)]})))) -(define $concat-  (lambda [$xs]-    (match xs (list something)-      {[<nil> {}]-       [<cons $x $rs> {@x @(concat rs)}]})))- (define $empty?   (match-lambda (list something)    {[<nil> #t]@@ -281,6 +271,20 @@         {[$tgt {tgt}]}]        }))) +(define $union+  (lambda [$a]+    (lambda [$xs $ys]+      {xs+       @(match-all [ys xs] [(multiset a) (multiset a)]+          [[<cons $y _> ^<cons ,y _>] y])+       })))++(define $intersect+  (lambda [$a]+    (lambda [$xs $ys]+      (match-all [xs ys] [(multiset a) (multiset a)]+        [[<cons $x _> <cons ,x _>] x]))))+ (define $set   (lambda [$a]     (matcher@@ -297,3 +301,4 @@        [$ [something]         {[$tgt {tgt}]}]        })))+

@@ -0,0 +1,88 @@+;;;;;+;;;;;+;;;;; Natural Number Library+;;;;;+;;;;;++(define $nat+  (matcher+    {[,$n []+      {[$tgt (if (eq? tgt n) {[]} {})]}]+     [<o> []+      {[0 {[]}]+       [_ {}]}]+     [<s $> nat+      {[$tgt (match (compare-integer tgt 0) ordering+               {[<greater> {(- tgt 1)}]+                [_ {}]})]}]+     [$ [something]+      {[$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 $fact+  (lambda [$n]+    (letrec {[$fact1 (lambda [$n $ret]+                       (match n [nat]+                         {[<o> ret]+                          [<s $n1> (fact1 n1 (* n ret))]}))]}+      (fact1 n 1))))++(define $divisor?+  (lambda [$n $d]+    (eq-i? 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)})]})))++;;;+;;; Number Collections+;;;+(define $nats {1 @(map (+ 1 $) nats)})++(define $nats0 {0 @(map (+ 1 $) nats0)})++(define $primes+  (letrec {[$next-primes+            (lambda [$primes1 $k]+              (let {[$primes2 (while (lte? $ (floor (sqrt (itof (* 6 (+ k 1)))))) primes1)]}+                (match [(one-of (lambda [$p] (eq? (remainder (+ (* 6 k) 1) p) 0)) primes2)+                        (one-of (lambda [$p] (eq? (remainder (+ (* 6 k) 5) p) 0)) primes2)]+                  [bool bool]+                  {[[,#f ,#f] {(+ (* 6 k) 1) (+ (* 6 k) 5) @(next-primes {@primes1 (+ (* 6 k) 1) (+ (* 6 k) 5)} (+ k 1))}]+                   [[,#f ,#t] {(+ (* 6 k) 1) @(next-primes {@primes1 (+ (* 6 k) 1)} (+ k 1))}]+                   [[,#t ,#f] {(+ (* 6 k) 5) @(next-primes {@primes1 (+ (* 6 k) 5)} (+ k 1))}]+                   [[,#t ,#t] (next-primes primes1 (+ k 1))]+                   })))]}+    {2 3 5 @(next-primes {2 3 5} 1)}))++;;;+;;; Prime Numbers+;;;+(define $find-factor+  (lambda [$n]+    (match primes (list integer)+      {[<join _ <cons (& ?(divisor? n $) $x) _>> x]})))++(define $prime-factorization+  (match-lambda nat+    {[,1 {}]+     [$n (let {[$p (find-factor n)]}+           {p @(prime-factorization (quotient n p))})]}))++(define $p-f prime-factorization)

@@ -1,3 +1,12 @@+;;;;;+;;;;;+;;;;; Number Library+;;;;;+;;;;;++;;;+;;; Integers+;;; (define $integer   (matcher     {[,$n []@@ -16,37 +25,6 @@             <Equal>             <Greater>)))) -(define $float-  (matcher-    {[,$d []-      {[$tgt (if (eq? tgt d) {[]} {})]}]-     [$ [something]-      {[$tgt {tgt}]}]-     }))--(define $compare-float-  (lambda [$d1 $d2]-    (if (lt? d1 d2)-        <Less>-        (if (eq? d1 d2)-            <Equal>-            <Greater>))))--(define $nat-  (matcher-    {[,$n []-      {[$tgt (if (eq? tgt n) {[]} {})]}]-     [<o> []-      {[0 {[]}]-       [_ {}]}]-     [<s $> nat-      {[$tgt (match (compare-integer tgt 0) ordering-               {[<greater> {(- tgt 1)}]-                [_ {}]})]}]-     [$ [something]-      {[$tgt {tgt}]}]-     }))- (define $between   (lambda [$m $n]     (match (compare-integer m n) ordering@@ -90,32 +68,6 @@                   {[<greater> [min-n n]]                    [_ [min-n max-n]]})]}))]}))) -(define $gcd-  (lambda [$ns]-    (match ns (set integer)-      {[<cons $n <nil>> n]-       [<cons (& ,(min ns) $m) $rs>-        (gcd {m @((remove-all integer) (map (lambda [$r] (mod r m)) rs)-                                       0)})]})))--(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 $fact-  (lambda [$n]-    (letrec {[$fact1 (lambda [$n $ret]-                       (match n [nat]-                         {[<o> ret]-                          [<s $n1> (fact1 n1 (* n ret))]}))]}-      (fact1 n 1))))- (define $mod   (lambda [$m]     (matcher@@ -127,18 +79,22 @@         {[$tgt {(modulo tgt m)}]}]        }))) -(define $nats {1 @(map (+ 1 $) nats)})+;;+;; Float Numbers+;;+(define $float+  (matcher+    {[,$d []+      {[$tgt (if (eq? tgt d) {[]} {})]}]+     [$ [something]+      {[$tgt {tgt}]}]+     })) -(define $primes-  (letrec {[$next-primes-            (lambda [$primes1 $k]-              (let {[$primes2 (while (lte? $ (floor (sqrt (itof (* 6 (+ k 1)))))) primes1)]}-                (match [(one-of (lambda [$p] (eq? (remainder (+ (* 6 k) 1) p) 0)) primes2)-                        (one-of (lambda [$p] (eq? (remainder (+ (* 6 k) 5) p) 0)) primes2)]-                  [bool bool]-                  {[[,#f ,#f] {(+ (* 6 k) 1) (+ (* 6 k) 5) @(next-primes {@primes1 (+ (* 6 k) 1) (+ (* 6 k) 5)} (+ k 1))}]-                   [[,#f ,#t] {(+ (* 6 k) 1) @(next-primes {@primes1 (+ (* 6 k) 1)} (+ k 1))}]-                   [[,#t ,#f] {(+ (* 6 k) 5) @(next-primes {@primes1 (+ (* 6 k) 5)} (+ k 1))}]-                   [[,#t ,#t] (next-primes primes1 (+ k 1))]-                   })))]}-    {2 3 5 @(next-primes {2 3 5} 1)}))+(define $compare-float+  (lambda [$d1 $d2]+    (if (lt? d1 d2)+        <Less>+        (if (eq? d1 d2)+            <Equal>+            <Greater>))))+

@@ -0,0 +1,31 @@+;;;;;+;;;;;+;;;;; Order Library+;;;;;+;;;;;++(define $ordering+  (algebraic-data-matcher +    {<less> <equal> <greater>}))++(define $split-by-ordering+  (lambda [$compare]+    (lambda [$xs $p]+      (match xs (list something)+        {[<nil> [{} {} {}]]+         [<cons $x $rs>+          (let {[[$ys1 $ys2 $ys3] ((split-by-ordering compare) rs p)]}+            (match (compare x p) ordering+              {[<less> [{x @ys1} ys2 ys3]]+               [<equal> [ys1 {x @ys2} ys3]]+               [<greater> [ys1 ys2 {x @ys3}]]}))]}))))++(define $qsort+  (lambda [$compare]+    (match-lambda (list something)+      {[<nil> {}]+       [<cons $x <nil>> {x}]+       [$xs (let {[$n (length xs)]}+              (let {[$p (nth (quotient n 2) xs)]}+                (let {[[$ys1 $ys2 $ys3] ((split-by-ordering compare) xs p)]}+                  {@((qsort compare) ys1) @ys2 @((qsort compare) ys3)})))]})))