diff --git a/Egison.hs b/Egison.hs --- a/Egison.hs +++ b/Egison.hs @@ -9,7 +9,7 @@ import IO hiding (try) welcomeMsg :: String -welcomeMsg = "Egison, version 0.3.1.0 : http://hagi.is.s.u-tokyo.ac.jp/~egi/egison/\nWelcome to Egison Interpreter!\n" +welcomeMsg = "Egison, version 0.3.1.1 : http://hagi.is.s.u-tokyo.ac.jp/~egi/egison/\nWelcome to Egison Interpreter!\n" byebyeMsg :: String byebyeMsg = "\nLeaving Egison.\nByebye. See you again! (^^)/\n" @@ -898,9 +898,9 @@ forceRecursivelyPattern (ValPat onEnv expr) = do return (ValPat onEnv expr) ---- ---- ---- +-- +-- +-- forceMatchExp :: Environment -> (IORef IntermidiateValue) -> (IORef IntermidiateValue) -> [MatchClause] -> IOThrowsError Value forceMatchExp env typIValRef tgtIValRef (MatchClause pat expr:rest) = do @@ -1038,9 +1038,9 @@ connectFrames (frame:frames) newFrames = (map (\newFrame -> (appendFrames frame newFrame)) newFrames) ++ (connectFrames frames newFrames) ---- ---- ---- +-- +-- +-- primitivePatternMatch :: PrimePat -> IORef IntermidiateValue -> IOThrowsError (Maybe Frame) primitivePatternMatch PrimeWildCard _ = return (Just (Frame [])) @@ -1168,9 +1168,9 @@ return (racRef, restRef) snocDeconstruct _ = throwError (Default "snocDeconstruct : not collection") ---- ---- ---- +-- +-- +-- valListToIValRefList :: [Value] -> IO [IORef IntermidiateValue] valListToIValRefList [] = return [] @@ -1261,9 +1261,9 @@ do innerVals <- loop vals return (Collection innerVals) ---- ---- Builtin Function ---- +-- +-- Builtin Function +-- getBuiltin :: String -> Maybe ([Value] -> IOThrowsError Value) getBuiltin name = @@ -1279,12 +1279,14 @@ "truncate" -> Just builtinTruncate "round" -> Just builtinRound "=" -> Just builtinEqual + "compare-integer" -> Just builtinCompareInteger "+" -> Just builtinPlus "-" -> Just builtinMinus "*" -> Just builtinMultiply - "/" -> Just builtinDevide + "dev" -> Just builtinDevide "mod" -> Just builtinMod "=f" -> Just builtinEqualFloat + "compare-float" -> Just builtinCompareFloat "+f" -> Just builtinPlusFloat "-f" -> Just builtinMinusFloat "*f" -> Just builtinMultiplyFloat @@ -1367,11 +1369,19 @@ builtinEqual :: [Value] -> IOThrowsError Value -builtinEqual [(Integer n1), (Integer n2)] = if (n1 == n2) - then return (InductiveData "true" []) - else return (InductiveData "false" []) +builtinEqual [(Integer n1), (Integer n2)] = if (n1 == n2) + then return (InductiveData "true" []) + else return (InductiveData "false" []) builtinEqual _ = throwError (Default "invalid args to =") +builtinCompareInteger :: [Value] -> IOThrowsError Value +builtinCompareInteger [(Integer n1), (Integer n2)] = if (n1 == n2) + then return (InductiveData "equal" []) + else if (n1 < n2) + then return (InductiveData "less" []) + else return (InductiveData "greater" []) +builtinCompareInteger _ = throwError (Default "invalid args to compare-integer") + builtinPlus :: [Value] -> IOThrowsError Value builtinPlus [(Integer n1), (Integer n2)] = return (Integer (n1 + n2)) builtinPlus _ = throwError (Default "invalid args to +") @@ -1386,7 +1396,7 @@ builtinDevide :: [Value] -> IOThrowsError Value builtinDevide [(Integer n1), (Integer n2)] = return (Integer (div n1 n2)) -builtinDevide _ = throwError (Default "invalid args to /") +builtinDevide _ = throwError (Default "invalid args to dev") builtinMod :: [Value] -> IOThrowsError Value builtinMod [(Integer n1), (Integer n2)] = return (Integer (mod n1 n2)) @@ -1399,6 +1409,14 @@ else return (InductiveData "false" []) builtinEqualFloat _ = throwError (Default "invalid args to =f") +builtinCompareFloat :: [Value] -> IOThrowsError Value +builtinCompareFloat [(Double n1), (Double n2)] = if (n1 == n2) + then return (InductiveData "equal" []) + else if (n1 < n2) + then return (InductiveData "less" []) + else return (InductiveData "greater" []) +builtinCompareFloat _ = throwError (Default "invalid args to compare-float") + builtinPlusFloat :: [Value] -> IOThrowsError Value builtinPlusFloat [(Double n1), (Double n2)] = return (Double (n1 + n2)) builtinPlusFloat _ = throwError (Default "invalid args to +f") @@ -1484,9 +1502,9 @@ builtinAtanh [Double d] = return (Double (atanh d)) builtinAtanh _ = throwError (Default "invalid args to atanh") ---- ---- for Debug : show Expression ---- +-- +-- for Debug : show Expression +-- showTopExpression :: TopExpression -> String showTopExpression (Define name expr) = "(define $" ++ name ++ " " ++ show expr ++ ")" diff --git a/egison.cabal b/egison.cabal --- a/egison.cabal +++ b/egison.cabal @@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented. -Version: 0.3.1.0 +Version: 0.3.1.1 -- A short (one-line) description of the package. Synopsis: An Interpreter for the Programming Language Egison diff --git a/etc/lib/base.egi b/etc/lib/base.egi --- a/etc/lib/base.egi +++ b/etc/lib/base.egi @@ -42,7 +42,7 @@ [$inductive-match (deconstructor {[less [] - {[ {[]}] + {[ {[]}] [_ {}]}] [equal [] {[ {[]}] diff --git a/etc/lib/collection.egi b/etc/lib/collection.egi --- a/etc/lib/collection.egi +++ b/etc/lib/collection.egi @@ -20,8 +20,7 @@ {[ {[{} {}]}] [ {[{} ts] - @(map (lambda [$as $bs] - [{x @as} bs]) + @(map (lambda [$as $bs] [{x @as} bs]) (loop xs))}]}))]} (loop tgt))]}] [nioj [(List a) (List a)] @@ -31,8 +30,7 @@ {[ {[{} {}]}] [ {[{} ts] - @(map (lambda [$as $bs] - [{@as x} bs]) + @(map (lambda [$as $bs] [{@as x} bs]) (loop xs))}]}))]} (loop tgt))]}]})] [$equal? (lambda [$val $tgt] @@ -73,7 +71,7 @@ (define $add (lambda [$a] (lambda [$xs $x] - (match ((member? Int) x xs) Bool + (match ((member? Integer) x xs) Bool {[ xs] [ {@xs x}]})))) diff --git a/etc/lib/number.egi b/etc/lib/number.egi --- a/etc/lib/number.egi +++ b/etc/lib/number.egi @@ -1,9 +1,12 @@ -(define $Number +(define $Integer (type {[$var-match (lambda [$tgt] {tgt})] [$equal? (lambda [$val $tgt] (= val tgt))]})) -(define $Int Number) +(define $Double + (type + {[$var-match (lambda [$tgt] {tgt})] + [$equal? (lambda [$val $tgt] (=f val tgt))]})) (define $Nat (type @@ -18,4 +21,3 @@ {[ {(- tgt 1)}] [_ {}]})]}]})] [$equal? (lambda [$val $tgt] (= val tgt))]})) - diff --git a/etc/sample/number-test.egi b/etc/sample/number-test.egi --- a/etc/sample/number-test.egi +++ b/etc/sample/number-test.egi @@ -17,7 +17,7 @@ (define $min (lambda [$ns] - (match ns (List Int) + (match ns (List Integer) {[> n] [ (let {[$r (min Rs)]} @@ -27,11 +27,10 @@ (define $gcd (lambda [$ns] - (let {[$ns2 ((remove-all Int) ns 0)]} - (match ns2 (Set Int) + (let {[$ns2 ((remove-all Integer) ns 0)]} + (match ns2 (Set Integer) {[> n] [ (gcd {n @(map (lambda [$r] (mod r n)) rs)})]})))) -