egison 2.1.8 → 2.1.9

raw patch · 7 files changed

+74/−43 lines, 7 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 +4/−1
• hs-src/Language/Egison/Numerical.hs +26/−28
• lib/core/base.egi +19/−10
• lib/core/number.egi +21/−1
• sample/io-test.egi +2/−1
• sample/number-test.egi +1/−1

@@ -1,5 +1,5 @@ Name:                egison-Version:             2.1.8+Version:             2.1.9 Synopsis:            An Interpreter for the Programming Language Egison Description:         An interpreter for the programming language Egison.                      A feature of Egison is the strong pattern match facility.

@@ -709,7 +709,7 @@   case obj of     Intermidiate (ITuple innerRefs) -> innerRefsToObjRefList innerRefs     Value (Tuple innerVals) -> innerValsToObjRefList innerVals-    _ -> throwError $ Default "tupleToObjRefList: not tuple"+    _ -> return [objRef]  innerRefsToObjRefList :: [InnerValRef] -> IOThrowsError [ObjectRef] innerRefsToObjRefList [] = return []@@ -828,6 +828,9 @@               ("gt-f?", floatBoolBinop (>)),               ("gte-f?", floatBoolBinop (>=)), +              ("eq-c?", charBoolBinop (==)),+              ("eq-s?", strBoolBinop (==)),+                             ("&&", boolBinop (&&)),               ("||", boolBinop (||))] 

@@ -1,30 +1,5 @@-module Language.Egison.Numerical (-   boolBinop- , numericSglop - , floatSglop- , floatNumSglop- , numericBinop- , floatBinop- , numBoolBinop- , floatBoolBinop--- , foldlM--- , foldl1M- , floatFloor- , floatCeiling- , floatTruncate- , floatRound- , numExpt- , numSqrt- , numExp- , numLog--- , numToString--- , floatToString- , unpackBool- , unpackNum- , unpackFloat-) where+module Language.Egison.Numerical where import Language.Egison.Types- import Control.Monad.Error --import Data.Char hiding (isNumber) --import Data.Fixed@@ -55,13 +30,24 @@ floatBinop _ singleVal@[_] = throwError $ NumArgs 2 singleVal floatBinop op aparams = mapM unpackFloat aparams >>= return . Float . foldl1 op +charBoolBinop :: (Char -> Char -> Bool) -> [EgisonVal] -> ThrowsError EgisonVal+charBoolBinop _ singleVal@[_] = throwError $ NumArgs 2 singleVal+charBoolBinop op aparams = mapM unpackChar aparams >>= doOp+  where doOp [a, b] = return $ Bool $ op a b+        doOp _ = throwError $ Default "Unexpected error in numCharBinop"++strBoolBinop :: (String -> String -> Bool) -> [EgisonVal] -> ThrowsError EgisonVal+strBoolBinop _ singleVal@[_] = throwError $ NumArgs 2 singleVal+strBoolBinop op aparams = mapM unpackString aparams >>= doOp+  where doOp [a, b] = return $ Bool $ op a b+        doOp _ = throwError $ Default "Unexpected error in numCharBinop"+ numBoolBinop :: (Integer -> Integer -> Bool) -> [EgisonVal] -> ThrowsError EgisonVal numBoolBinop _ singleVal@[_] = throwError $ NumArgs 2 singleVal numBoolBinop op aparams = mapM unpackNum aparams >>= doOp   where doOp [a, b] = return $ Bool $ op a b         doOp _ = throwError $ Default "Unexpected error in numBoolBinop" - floatBoolBinop :: (Double -> Double -> Bool) -> [EgisonVal] -> ThrowsError EgisonVal floatBoolBinop _ singleVal@[_] = throwError $ NumArgs 2 singleVal floatBoolBinop op aparams = mapM unpackFloat aparams >>= doOp@@ -137,11 +123,23 @@  -- - end Numeric operations section --- |Extract an integer from the given value, throwing a type error if+-- |Extract an bool from the given value, throwing a type error if --  the wrong type is passed. unpackBool :: EgisonVal -> ThrowsError Bool unpackBool (Bool b) = return b unpackBool notBool = throwError $ TypeMismatch "bool" notBool++-- |Extract an char from the given value, throwing a type error if+--  the wrong type is passed.+unpackChar :: EgisonVal -> ThrowsError Char+unpackChar (Char c) = return c+unpackChar notChar = throwError $ TypeMismatch "char" notChar++-- |Extract an char from the given value, throwing a type error if+--  the wrong type is passed.+unpackString :: EgisonVal -> ThrowsError String+unpackString (String str) = return str+unpackString notString = throwError $ TypeMismatch "string" notString  -- |Extract an integer from the given value, throwing a type error if --  the wrong type is passed.

@@ -26,22 +26,32 @@  (define $or   (lambda [$b1 $b2]-    (if b1-        #t-        b2)))+    (match b1 Bool+      {[<true> #t]+       [<false> b2]})))  (define $and   (lambda [$b1 $b2]-    (if b1-        b2-        #f)))+    (match b1 Bool+      {[<true> b2]+       [<false> #f]})))  (define $not   (lambda [$b]-    (if b-        #f-        #t)))+    (match b Bool+      {[<true> #f]+       [<false> #t]}))) +(define $Char+  (type+    {[$var-match (lambda [$tgt] {tgt})]+     [$= eq-c?]}))++(define $String+  (type+    {[$var-match (lambda [$tgt] {tgt})]+     [$= eq-s?]}))+ (define $Order   (type     {[$var-match (lambda [$tgt] {tgt})]@@ -63,4 +73,3 @@            [[<equal> <equal>] #t]            [[<greater> <greater>] #t]            [[_ _] #f]}))]}))-

@@ -16,6 +16,14 @@     {[$var-match (lambda [$tgt] {tgt})]      [$= (lambda [$val $tgt] (eq-f? val tgt))]})) +(define $compare-float+  (lambda [$d1 $d2]+    (if (lt-f? d1 d2)+        <less>+        (if (eq-f? d1 d2)+            <equal>+            <greater>))))+ (define $Nat   (type     {[$var-match (lambda [$tgt] {tgt})]@@ -24,7 +32,7 @@         {[o []           {[0 {[]}]            [_ {}]}]-         [s [Nat]+         [s Nat           {[$tgt (match (compare-integer tgt 0) Order                    {[<greater> {(- tgt 1)}]                     [_ {}]})]}]})]@@ -56,6 +64,18 @@           (match (compare-integer n r) Order             {[<greater> n]              [_ r]}))]})))++(define $min&max+  (lambda [$ns]+    (match ns (List Integer)+      {[<cons $n <nil>> [n n]]+       [<cons $n $rs>+        (let {[[$min-n $max-n] (min&max rs)]}+          (match (compare-integer n min-n) Order+            {[<less> [n max-n]]+             [_ (match (compare-integer n max-n) Order+                  {[<greater> [min-n n]]+                   [_ [min-n max-n]]})]}))]})))  (define $gcd   (lambda [$ns]

@@ -12,7 +12,8 @@ (define $main   (lambda [$: $argv]     (do {[[$: $p] (open-output-file : "hello.txt")]-         [$: (print-to-port : p "Hello world!")]}+         [$: (print-to-port : p "Hello world!")]+         [$: (close-output-port : p)]}         :)))  (define $main

@@ -9,7 +9,7 @@  (define $fact   (lambda [$n]-    (match n Nat+    (match n [Nat]       {[<o> 1]        [<s $n1> (* n (fact n1))]})))