egison 3.2.8 → 3.2.9

raw patch · 8 files changed

+95/−17 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• egison.cabal +1/−1
• hs-src/Language/Egison/Core.hs +7/−1
• hs-src/Language/Egison/Parser.hs +5/−7
• hs-src/Language/Egison/Primitives.hs +7/−2
• hs-src/Language/Egison/Types.hs +1/−1
• lib/core/base.egi +1/−1
• lib/core/collection.egi +72/−2
• lib/core/number.egi +1/−2

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

@@ -512,7 +512,13 @@                      _ -> -- Value Something -> -- for tupple patterns           case pattern of-            WildCard -> return $ msingleton $ MState env loops bindings trees +            ValuePat valExpr -> do+              val <- evalExpr' env' valExpr+              tgtVal <- evalRef' target+              if val == tgtVal+                then return $ msingleton $ MState env loops bindings trees+                else return MNil+            WildCard -> return $ msingleton $ MState env loops bindings trees             PatVar name -> return $ msingleton $ MState env loops ((name, target):bindings) trees             IndexedPat (PatVar name) indices -> do               indices <- mapM (evalExpr env' >=> liftError . liftM fromInteger . fromIntegerValue) indices

@@ -18,6 +18,7 @@ import Control.Applicative ((<$>), (<*>), (*>), (<*), pure)  import System.Directory (doesFileExist)+import System.IO  import qualified Data.Sequence as Sq import Data.Either@@ -27,11 +28,8 @@ import Data.Traversable (mapM) import Data.Ratio -import Data.ByteString.Lazy (ByteString)-import Data.ByteString.Lazy.Char8 ()-import qualified Data.ByteString.Lazy.Char8 as B import Text.Parsec-import Text.Parsec.ByteString.Lazy+import Text.Parsec.String import Text.Parsec.Combinator import qualified Text.Parsec.Token as P @@ -40,7 +38,7 @@ import Paths_egison (getDataFileName)    doParse :: Parser a -> String -> Either EgisonError a-doParse p input = either (throwError . fromParsecError) return $ parse p "egison" $ B.pack input+doParse p input = either (throwError . fromParsecError) return $ parse p "egison" input   where     fromParsecError :: ParseError -> EgisonError     fromParsecError = Parser . show@@ -427,7 +425,7 @@ -- Tokens -- -egisonDef :: P.GenLanguageDef ByteString () Identity+egisonDef :: P.GenLanguageDef String () Identity egisonDef =    P.LanguageDef { P.commentStart       = "#|"                 , P.commentEnd         = "|#"@@ -444,7 +442,7 @@   symbol1 = oneOf "+-*/="   symbol2 = symbol1 <|> oneOf "!?" -lexer :: P.GenTokenParser ByteString () Identity+lexer :: P.GenTokenParser String () Identity lexer = P.makeTokenParser egisonDef  reservedKeywords :: [String]

@@ -125,6 +125,7 @@              , ("truncate", floatToIntegerOp truncate)              , ("itof", integerToFloat)              , ("rtof", rationalToFloat)+             , ("itos", integerToString)              , ("eq?",  eq)              , ("lt?",  lt)              , ("lte?", lte)@@ -179,6 +180,10 @@ rationalToFloat = (liftError .) $ oneArg $ \val ->   Float . fromRational <$> fromRationalValue val +integerToString :: PrimitiveFunc+integerToString = (liftError .) $ oneArg $ \val ->+   makeStringValue . show <$> fromIntegerValue val+ eq :: PrimitiveFunc eq = (liftError .) $ twoArgs $ \val val' ->   (Bool .) . (==) <$> fromPrimitiveValue val@@ -356,8 +361,8 @@                , ("write-to-port", writeToPort)                , ("eof-port?", isEOFPort) --             , ("print-to-port", writeStringLineToPort)-               , ("flush-port", flushPort) -               , ("rand", randRange) ]                 +               , ("flush-port", flushPort)+               , ("rand", randRange) ] --             , ("get-lib-dir-name", getLibDirName) ]  makeIO :: EgisonM EgisonValue -> EgisonValue

@@ -169,7 +169,7 @@ type PrimitiveFunc = [WHNFData] -> EgisonM EgisonValue  instance Show EgisonValue where-  show (Char c) = show c+  show (Char c) = "'" ++ [c] ++ "'"   show (Bool True) = "#t"   show (Bool False) = "#f"   show (Rational x) = show (numerator x) ++ "/" ++ show (denominator x)

@@ -40,7 +40,7 @@       {[$tgt {tgt}]}]      })) -(define $match?/m+(define $eq?/m   (lambda [$a $x $y]     (match x a       {[,y #t]

@@ -129,12 +129,27 @@    {[<nil> #t]     [<cons _ _> #f]})) +(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]}))) +(define $include?+  (lambda [$a $xs $ys]+    (match xs (list something)+      {[<nil> #t]+       [<cons $x $rest>+        (if (member? x ys)+          (include? rest ys)+          #f)]})))+ (define $include?/m   (lambda [$a $xs $ys]     (match xs (list something)@@ -171,10 +186,15 @@       {[<nil> 0]        [<cons _ $rs> (+ 1 (length rs))]}))) +(define $count+  (lambda [$x $xs]+    (length (match-all xs (list something)+              [<join _ <cons ,x _>> x]))))+ (define $count/m   (lambda [$a $x $xs]     (length (match-all xs (list a)-              [<join _ <cons $x _>> x]))))+              [<join _ <cons ,x _>> x]))))  ;; ;; Simple accessors@@ -278,12 +298,25 @@ ;; ;; multiset operation (Don't use multiset matcher) ;;+(define $add+  (lambda [$x $xs]+    (if (member? x xs)+      xs+      {@xs x})))+ (define $add/m   (lambda [$a $x $xs]-    (if ((member? a) x xs)+    (if (member?/m a x xs)       xs       {@xs x}))) +(define $delete-first+  (lambda [$x $xs]+    (match xs (list something)+      {[<nil> {}]+       [<cons ,x $rs> rs]+       [<cons $y $rs> {y @(delete-first x rs)}]})))+ (define $delete-first/m   (lambda [$a $x $xs]     (match xs (list a)@@ -291,6 +324,13 @@        [<cons ,x $rs> rs]        [<cons $y $rs> {y @(delete-first/m a x rs)}]}))) +(define $delete+  (lambda [$x $xs]+    (match xs (list something)+      {[<nil> {}]+       [<cons ,x $rs> (delete x rs)]+       [<cons $y $rs> {y @(delete x rs)}]})))+ (define $delete/m   (lambda [$a $x $xs]     (match xs (list a)@@ -298,12 +338,25 @@        [<cons ,x $rs> (delete/m a x rs)]        [<cons $y $rs> {y @(delete/m a x rs)}]}))) +(define $difference+  (lambda [$xs $ys]+    (match ys (list something)+      {[<nil> xs]+       [<cons $y $rs> (difference (delete-first y xs) 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+  (lambda [$xs $ys]+    {xs+     @(match-all [ys xs] [(multiset something) (multiset something)]+        [[<cons $y _> ^<cons ,y _>] y])+     }))+ (define $union/m   (lambda [$a $xs $ys]     {xs@@ -311,6 +364,11 @@         [[<cons $y _> ^<cons ,y _>] y])      })) +(define $intersect+  (lambda [$xs $ys]+    (match-all [xs ys] [(multiset something) (multiset something)]+      [[<cons $x _> <cons ,x _>] x])))+ (define $intersect/m   (lambda [$a $xs $ys]     (match-all [xs ys] [(multiset a) (multiset a)]@@ -339,6 +397,18 @@ ;; ;; set operation ;;+(define $unique+  (lambda [$xs]+    (letrec {[$loop-fn+              (lambda [$xs $ys]+                (match xs (list something)+                  {[<nil> ys]+                   [<cons $x $rs>+                    (if (member? x ys)+                      (loop-fn rs ys)+                      (loop-fn rs {@ys x}))]}))]}+      (loop-fn xs {}))))+ (define $unique/m   (lambda [$a $xs]     (letrec {[$loop-fn

@@ -69,7 +69,7 @@                    {[]}                    {})]}]        [$ [something]-        {[$tgt {(modulo tgt m)}]}]+        {[$tgt {tgt}]}]        })))  ;;@@ -90,4 +90,3 @@         (if (eq? d1 d2)             <Equal>             <Greater>))))-