egison 3.2.7 → 3.2.8

raw patch · 9 files changed

+179/−143 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• egison.cabal +1/−1
• hs-src/Interpreter/egisoni.hs +2/−1
• hs-src/Language/Egison/Parser.hs +1/−1
• hs-src/Language/Egison/Primitives.hs +9/−0
• hs-src/Language/Egison/Types.hs +0/−1
• lib/core/base.egi +5/−6
• lib/core/collection.egi +156/−116
• lib/core/natural-number.egi +4/−4
• lib/core/number.egi +1/−13

@@ -1,5 +1,5 @@ Name:                egison-Version:             3.2.7+Version:             3.2.8 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,

@@ -123,7 +123,8 @@   liftIO (runInputT (settings home) $ (loop env prompt ""))   where     settings :: MonadIO m => FilePath -> Settings m-    settings home = defaultSettings { historyFile = Just (home </> ".egison_history") }+    settings home = do+      setComplete noCompletion $ defaultSettings { historyFile = Just (home </> ".egison_history") }          loop :: Env -> String -> String -> InputT IO ()     loop env prompt' rest = do

@@ -442,7 +442,7 @@                 , P.caseSensitive      = True }  where   symbol1 = oneOf "+-*/="-  symbol2 = symbol1 <|> oneOf "+-!?"+  symbol2 = symbol1 <|> oneOf "!?"  lexer :: P.GenTokenParser ByteString () Identity lexer = P.makeTokenParser egisonDef

@@ -134,6 +134,7 @@              , ("-", minus)              , ("*", multiply)              , ("/", divide)+             , ("/-inverse", divideInverse)              , ("string-append", stringAppend)              , ("assert", assert)              , ("assert-equal", assertEqual) ]@@ -298,6 +299,14 @@   divide' (Value (Float _)) val = throwError $ TypeMismatch "number" val   divide' val _ = throwError $ TypeMismatch "number" val +divideInverse :: PrimitiveFunc+divideInverse = (liftError .) $ oneArg $ divideInverse'+ where+  divideInverse' (Value (Rational rat)) = do+    return $ Tuple [Integer (numerator rat), Integer (denominator rat)]+  divideInverse' (Value (Integer x)) = do+    return $ Tuple [Integer x, Integer 1]+  divideInverse' val = throwError $ TypeMismatch "rational" val  stringAppend :: PrimitiveFunc stringAppend = (liftError .) $ twoArgs $ \val val' -> do

@@ -23,7 +23,6 @@ import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap -import qualified Data.HashMap.Lazy as HL import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as BL import Data.ByteString.Lazy.Char8 ()

@@ -40,12 +40,11 @@       {[$tgt {tgt}]}]      })) -(define $match?-  (lambda [$a]-    (lambda [$x $y]-      (match x a-        {[,y #t]-         [_ #f]}))))+(define $match?/m+  (lambda [$a $x $y]+    (match x a+      {[,y #t]+       [_ #f]})))  (define $compose   (lambda [$f $g]

@@ -1,7 +1,10 @@-;;-;; Collection.egi-;;+;;;;;+;;;;; Collection.egi+;;;;; +;;;+;;; List+;;; (define $list   (lambda [$a]     (matcher@@ -41,6 +44,15 @@  (define $string (list char)) +;;+;; 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 (gt-i? (+ s 10) e)@@ -50,12 +62,35 @@       {s (+ s 1) (+ s 2) (+ s 3) (+ s 4) (+ s 5) (+ s 6) (+ s 7) (+ s 8) (+ s 9) (+ s 10) @(between (+ s 11) e)})     )) -(define $map-  (lambda [$fn $xs]+;;+;; list functions+;;+(define $repeat1+  (lambda [$x]+    {x @(repeat1 x)}))++(define $repeat+  (lambda [$xs]+    {@xs @(repeat xs)}))++(define $filter+  (lambda [$pred $xs]     (match xs (list something)       {[<nil> {}]-       [<cons $x $rs> {(fn x) @(map fn rs)}]})))+       [<cons $x $rs>+        (if (pred x)+            {x @(filter pred rs)}+            (filter pred rs))]}))) +(define $split+  (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 $concat   (lambda [$xss]     (match xss (list something)@@ -75,85 +110,75 @@        [<cons $x $xs> (let {[$y (fn init x)]}                         (foldl fn y xs))]}))) -(define $filter-  (lambda [$pred $xs]-    (match xs (list something)-      {[<nil> {}]-       [<cons $x $rs>-        (if (pred x)-            {x @(filter pred rs)}-            (filter pred rs))]})))--(define $split-  (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 $remove-  (lambda [$a]-    (lambda [$xs $x]-      (match xs (list a)-        {[<nil> {}]-         [<cons ,x $rs> rs]-         [<cons $y $rs> {y @((remove a) rs x)}]}))))+(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 $remove-all-  (lambda [$a]-    (lambda [$xs $x]-      (match xs (list a)-        {[<nil> {}]-         [<cons ,x $rs> ((remove-all a) rs x)]-         [<cons $y $rs> {y @((remove-all a) rs x)}]}))))+(define $zip+  (lambda [$xs $ys]+    (map2 (lambda [$x $y] [x y]) xs ys))) -(define $remove-collection-  (lambda [$a]-    (lambda [$xs $ys]-      (match ys (list a)-        {[<nil> xs]-         [<cons $y $rs> ((remove-collection a) ((remove a) xs y) rs)]}))))+;;+;; Simple predicate+;;+(define $empty?+  (match-lambda (list something)+   {[<nil> #t]+    [<cons _ _> #f]})) -(define $add-  (lambda [$a]-    (lambda [$xs $x]-      (if ((member? a) x xs)-          xs-          {@xs x}))))+(define $member?/m+  (lambda [$a $x $ys]+    (match ys (list a)+      {[<join _ <cons ,x _>> #t]+       [_ #f]}))) -(define $occurrence-  (lambda [$a]-    (lambda [$xs]-      (letrec {[$remove-and-count-                (lambda [$x $xs]-                  (match xs (list a)-                    {[<nil> [{} 1]]-                     [<cons ,x $ys> (let {[[$r $i] (remove-and-count x ys)]}-                                      [r (+ i 1)])]-                     [<cons $y $ys> (let {[[$r $i] (remove-and-count x ys)]}-                                      [{y @r} i])]}))]}-        (match xs (list something)-          {[<nil> {}]-           [<cons $x $ys> (let {[[$rs $i] (remove-and-count x ys)]}-                            {[x i] @((occurrence a) 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 $one-of+(define $any   (lambda [$pred $xs]     (match xs (list something)       {[<nil> #f]        [<cons $x $rs>         (if (pred x)             #t-            (one-of pred rs))]})))+            (any pred rs))]}))) +(define $all+  (lambda [$pred $xs]+    (match xs (list something)+      {[<nil> #t]+       [<cons $x $rs>+        (if (pred x)+            #f+            (all pred rs))]})))++;;+;; Counting+;; (define $length   (lambda [$xs]     (match xs (list something)       {[<nil> 0]        [<cons _ $rs> (+ 1 (length rs))]}))) +(define $count/m+  (lambda [$a $x $xs]+    (length (match-all xs (list a)+              [<join _ <cons $x _>> x]))))++;;+;; Simple accessors+;; (define $car   (lambda [$xs]     (match xs (list something)@@ -213,6 +238,9 @@             {x @(while pred rs)}             {})]}))) +;;+;; Others+;; (define $reverse   (lambda [$xs]     (match xs (list something)@@ -220,42 +248,9 @@        [<cons $x $rs>         {@(reverse rs) x}]}))) -(define $member?-  (lambda [$a]-    (lambda [$x $ys]-      (match ys (list a)-        {[<nil> #f]-         [<cons ,x $ys> #t]-         [<cons $y $ys> ((member? a) x ys)]}))))--(define $unique-  (lambda [$a]-    (lambda [$xs]-      (letrec {[$loop-fn-                (lambda [$xs $ys]-                  (match xs (list something)-                    {[<nil> ys]-                     [<cons $x $rs>-                      (if ((member? a) x ys)-                          (loop-fn rs ys)-                          (loop-fn rs {@ys x}))]}))]}-        (loop-fn xs {})))))--(define $subcollection?-  (lambda [$a]-    (lambda [$xs $ys]-      (match xs (list something)-        {[<nil> #t]-         [<cons $x $rest>-          (if ((member? a) x ys)-              ((subcollection? a) rest ys)-              #f)]}))))--(define $empty?-  (match-lambda (list something)-   {[<nil> #t]-    [<cons _ _> #f]}))-+;;;+;;; Multiset+;;; (define $multiset   (lambda [$a]     (matcher@@ -275,25 +270,55 @@         {[$tgt (match-all tgt (list a)                  [<join $hs <cons $x $ts>> [x {@hs @ts}]])]}]        [<join ,$pxs $> [(multiset a)]-        {[$tgt {((remove-collection a) tgt pxs)}]}]+        {[$tgt {(difference/m a tgt pxs)}]}]        [$ [something]         {[$tgt {tgt}]}]        }))) -(define $union-  (lambda [$a]-    (lambda [$xs $ys]-      {xs-       @(match-all [ys xs] [(multiset a) (multiset a)]-          [[<cons $y _> ^<cons ,y _>] y])-       })))+;;+;; multiset operation (Don't use multiset matcher)+;;+(define $add/m+  (lambda [$a $x $xs]+    (if ((member? a) x xs)+      xs+      {@xs x}))) -(define $intersect-  (lambda [$a]-    (lambda [$xs $ys]-      (match-all [xs ys] [(multiset a) (multiset a)]-        [[<cons $x _> <cons ,x _>] x]))))+(define $delete-first/m+  (lambda [$a $x $xs]+    (match xs (list a)+      {[<nil> {}]+       [<cons ,x $rs> rs]+       [<cons $y $rs> {y @(delete-first/m a x rs)}]}))) +(define $delete/m+  (lambda [$a $x $xs]+    (match xs (list a)+      {[<nil> {}]+       [<cons ,x $rs> (delete/m a x rs)]+       [<cons $y $rs> {y @(delete/m a x rs)}]})))++(define $difference/m+  (lambda [$a $xs $ys]+    (match ys (list a)+      {[<nil> xs]+       [<cons $y $rs> (difference/m a (delete-first/m a y xs) rs)]})))++(define $union/m+  (lambda [$a $xs $ys]+    {xs+     @(match-all [ys xs] [(multiset a) (multiset a)]+        [[<cons $y _> ^<cons ,y _>] y])+     }))++(define $intersect/m+  (lambda [$a $xs $ys]+    (match-all [xs ys] [(multiset a) (multiset a)]+      [[<cons $x _> <cons ,x _>] x])))++;;;+;;; Set+;;; (define $set   (lambda [$a]     (matcher@@ -310,3 +335,18 @@        [$ [something]         {[$tgt {tgt}]}]        })))++;;+;; set operation+;;+(define $unique/m+  (lambda [$a $xs]+    (letrec {[$loop-fn+              (lambda [$xs $ys]+                (match xs (list something)+                  {[<nil> ys]+                   [<cons $x $rs>+                    (if (member?/m a x ys)+                      (loop-fn rs ys)+                      (loop-fn rs {@ys x}))]}))]}+      (loop-fn xs {}))))

@@ -61,8 +61,8 @@   (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)]+                (match [(any (lambda [$p] (eq? (remainder (+ (* 6 k) 1) p) 0)) primes2)+                        (any (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))}]@@ -87,9 +87,9 @@  (define $p-f prime-factorization) -(define $p-fs (map (lambda [$n] [n (p-f n)]) nats))+(define $pfs (map (lambda [$n] [n (p-f n)]) nats)) -(define $p-fs-n+(define $pfs-n   (lambda [$n]     (match-all p-fs (list [integer (list integer)])       [<join _ <cons [$m (loop $i [1 ,n] <cons $p_i ...> <nil>)] _>> [m (map (lambda [$i] p_i) (between 1 n))]])))

@@ -25,17 +25,6 @@             <Equal>             <Greater>)))) -(define $between-  (lambda [$m $n]-    (match (compare-integer m n) ordering-      {[<less> {m @(between (+ m 1) n)}]-       [<equal> {n}]-       [<greater> {}]})))--(define $from-  (lambda [$m]-    {m @(from (+ m 1))}))- (define $min   (lambda [$ns]     (match ns (list integer)@@ -70,8 +59,7 @@  (define $power   (lambda [$x $n]-    (letrec {[$xs {x @xs}]}-      (foldl * 1 (take n xs)))))+    (foldl * 1 (take n (repeat1 x)))))  (define $mod   (lambda [$m]