egison 3.2.4 → 3.2.5

raw patch · 6 files changed

+103/−8 lines, 6 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 +1/−0
• hs-src/Language/Egison/Parser.hs +16/−4
• hs-src/Language/Egison/Primitives.hs +74/−3
• hs-src/Language/Egison/Types.hs +4/−0
• lib/core/natural-number.egi +7/−0

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

@@ -74,6 +74,7 @@ evalExpr _ (CharExpr c) = return . Value $ Char c evalExpr _ (StringExpr s) = return $ Value $ makeStringValue s evalExpr _ (BoolExpr b) = return . Value $ Bool b+evalExpr _ (RationalExpr x) = return . Value $ Rational x evalExpr _ (IntegerExpr i) = return . Value $ Integer i evalExpr _ (FloatExpr d) = return . Value $ Float d 

@@ -25,6 +25,7 @@ import Data.Char (isLower, isUpper) import qualified Data.Set as Set import Data.Traversable (mapM)+import Data.Ratio  import Data.ByteString.Lazy (ByteString) import Data.ByteString.Lazy.Char8 ()@@ -394,6 +395,7 @@                  <|> stringExpr                  <|> boolExpr                  <|> try floatExpr+                 <|> try rationalExpr                  <|> integerExpr                  <|> (keywordSomething *> pure SomethingExpr)                  <|> (keywordUndefined *> pure UndefinedExpr)@@ -408,12 +410,19 @@ boolExpr :: Parser EgisonExpr boolExpr = BoolExpr <$> boolLiteral -integerExpr :: Parser EgisonExpr-integerExpr = IntegerExpr <$> integerLiteral- floatExpr :: Parser EgisonExpr floatExpr = FloatExpr <$> floatLiteral +rationalExpr :: Parser EgisonExpr+rationalExpr = do+  m <- integerLiteral+  char '/'+  n <- naturalLiteral+  return $ RationalExpr (m % n)++integerExpr :: Parser EgisonExpr+integerExpr = IntegerExpr <$> integerLiteral+ -- -- Tokens --@@ -432,7 +441,7 @@                 , P.nestedComments     = True                 , P.caseSensitive      = True }  where-  symbol1 = oneOf "&*/:="+  symbol1 = oneOf "+-*/="   symbol2 = symbol1 <|> oneOf "+-!?"  lexer :: P.GenTokenParser ByteString () Identity@@ -512,6 +521,9 @@ sign = (char '-' >> return negate)    <|> (char '+' >> return id)    <|> return id++naturalLiteral :: Parser Integer+naturalLiteral = P.natural lexer  integerLiteral :: Parser Integer integerLiteral = sign <*> P.natural lexer

@@ -7,6 +7,7 @@  import Data.IORef import qualified Data.Array as A+import Data.Ratio  import System.IO import System.Random@@ -81,9 +82,9 @@ --  primitives :: [(String, PrimitiveFunc)]-primitives = [ ("+", integerBinaryOp (+)) -             , ("-", integerBinaryOp (-))-             , ("*", integerBinaryOp (*))+primitives = [ ("+i", integerBinaryOp (+)) +             , ("-i", integerBinaryOp (-))+             , ("*i", integerBinaryOp (*))              , ("modulo",    integerBinaryOp mod)              , ("quotient",   integerBinaryOp quot)              , ("remainder", integerBinaryOp rem)@@ -128,6 +129,10 @@              , ("lte?", lte)              , ("gt?",  gt)              , ("gte?", gte)+             , ("+", plus)+             , ("-", minus)+             , ("*", multiply)+             , ("/", divide)              , ("string-append", stringAppend)              , ("assert", assert)              , ("assert-equal", assertEqual) ]@@ -217,6 +222,72 @@   gte' (Value (Float _)) val = throwError $ TypeMismatch "number" val   gte' val _ = throwError $ TypeMismatch "number" val +plus :: PrimitiveFunc+plus = (liftError .) $ twoArgs plus'+ where+  plus' (Value (Integer x)) (Value (Integer x')) = return $ Integer $ (x + x')+  plus' (Value (Integer i)) val = plus' (Value (Rational (i % 1))) val+  plus' val (Value (Integer i)) = plus' val (Value (Rational (i % 1)))+  plus' (Value (Rational x)) (Value (Rational x')) = let y = (x + x') in+                                                      if denominator y == 1+                                                        then return $ Integer $ numerator y+                                                        else return $ Rational y+  plus' (Value (Float f)) (Value (Float f')) = return $ Float $ f + f'+  plus' (Value (Rational i)) (Value (Float f)) = return $ Float $ (fromRational i) + f+  plus' (Value (Float f)) (Value (Rational i)) = return $ Float $ f + (fromRational i)+  plus' (Value (Rational _)) val = throwError $ TypeMismatch "number" val+  plus' (Value (Float _)) val = throwError $ TypeMismatch "number" val+  plus' val _ = throwError $ TypeMismatch "number" val++minus :: PrimitiveFunc+minus = (liftError .) $ twoArgs minus'+ where+  minus' (Value (Integer x)) (Value (Integer x')) = return $ Integer $ (x - x')+  minus' (Value (Integer i)) val = minus' (Value (Rational (i % 1))) val+  minus' val (Value (Integer i)) = minus' val (Value (Rational (i % 1)))+  minus' (Value (Rational x)) (Value (Rational x')) = let y = (x - x') in+                                                      if denominator y == 1+                                                        then return $ Integer $ numerator y+                                                        else return $ Rational y+  minus' (Value (Float f)) (Value (Float f')) = return $ Float $ f - f'+  minus' (Value (Rational i)) (Value (Float f)) = return $ Float $ (fromRational i) - f+  minus' (Value (Float f)) (Value (Rational i)) = return $ Float $ f - (fromRational i)+  minus' (Value (Rational _)) val = throwError $ TypeMismatch "number" val+  minus' (Value (Float _)) val = throwError $ TypeMismatch "number" val+  minus' val _ = throwError $ TypeMismatch "number" val++multiply :: PrimitiveFunc+multiply = (liftError .) $ twoArgs multiply'+ where+  multiply' (Value (Integer x)) (Value (Integer x')) = return $ Integer $ (x * x')+  multiply' (Value (Integer i)) val = multiply' (Value (Rational (i % 1))) val+  multiply' val (Value (Integer i)) = multiply' val (Value (Rational (i % 1)))+  multiply' (Value (Rational x)) (Value (Rational x')) = let y = (x * x') in+                                                      if denominator y == 1+                                                        then return $ Integer $ numerator y+                                                        else return $ Rational y+  multiply' (Value (Float f)) (Value (Float f')) = return $ Float $ f * f'+  multiply' (Value (Rational i)) (Value (Float f)) = return $ Float $ (fromRational i) * f+  multiply' (Value (Float f)) (Value (Rational i)) = return $ Float $ f * (fromRational i)+  multiply' (Value (Rational _)) val = throwError $ TypeMismatch "number" val+  multiply' (Value (Float _)) val = throwError $ TypeMismatch "number" val+  multiply' val _ = throwError $ TypeMismatch "number" val++divide :: PrimitiveFunc+divide = (liftError .) $ twoArgs divide'+ where+  divide' (Value (Integer x)) (Value (Integer x')) = return $ Rational $ (x % x')+  divide' (Value (Integer i)) val = divide' (Value (Rational (i % 1))) val+  divide' val (Value (Integer i)) = divide' val (Value (Rational (i % 1)))+  divide' (Value (Rational x)) (Value (Rational x')) =+    let m = numerator x' in+    let n = denominator x' in+    let y = (x * (n % m)) in+      if denominator y == 1+        then return $ Integer $ numerator y+        else return $ Rational y+  divide' (Value (Rational _)) val = throwError $ TypeMismatch "rational number" val+  divide' val _ = throwError $ TypeMismatch "rational number" val   stringAppend :: PrimitiveFunc

@@ -29,6 +29,7 @@ import System.IO import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap+import Data.Ratio  -- -- Expressions@@ -47,6 +48,7 @@     CharExpr Char   | StringExpr String   | BoolExpr Bool+  | RationalExpr Rational   | IntegerExpr Integer   | FloatExpr Double   | VarExpr String@@ -142,6 +144,7 @@     World   | Char Char   | Bool Bool+  | Rational Rational   | Integer Integer   | Float Double   | InductiveData String [EgisonValue]@@ -167,6 +170,7 @@   show (Char c) = show c   show (Bool True) = "#t"   show (Bool False) = "#f"+  show (Rational x) = show (numerator x) ++ "/" ++ show (denominator x)   show (Integer i) = show i   show (Float f) = show f   show (InductiveData name []) = "<" ++ name ++ ">"

@@ -86,3 +86,10 @@            {p @(prime-factorization (quotient n p))})]}))  (define $p-f prime-factorization)++(define $p-fs (map (lambda [$n] [n (p-f n)]) nats))++(define $p-fs-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))]])))