egison 0.3.1.0 → 0.3.1.1
raw patch · 6 files changed
+52/−35 lines, 6 files
Files
- Egison.hs +39/−21
- egison.cabal +1/−1
- etc/lib/base.egi +1/−1
- etc/lib/collection.egi +3/−5
- etc/lib/number.egi +5/−3
- etc/sample/number-test.egi +3/−4
Egison.hs view
@@ -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 ++ ")"
egison.cabal view
@@ -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
etc/lib/base.egi view
@@ -42,7 +42,7 @@ [$inductive-match (deconstructor {[less []- {[<equal> {[]}]+ {[<less> {[]}] [_ {}]}] [equal [] {[<equal> {[]}]
etc/lib/collection.egi view
@@ -20,8 +20,7 @@ {[<nil> {[{} {}]}] [<cons $x $xs> {[{} 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 @@ {[<nil> {[{} {}]}] [<snoc $x $xs> {[{} 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 {[<true> xs] [<false> {@xs x}]}))))
etc/lib/number.egi view
@@ -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 @@ {[<greater> {(- tgt 1)}] [_ {}]})]}]})] [$equal? (lambda [$val $tgt] (= val tgt))]}))-
etc/sample/number-test.egi view
@@ -17,7 +17,7 @@ (define $min (lambda [$ns]- (match ns (List Int)+ (match ns (List Integer) {[<cons $n <nil>> n] [<cons $n $rs> (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) {[<cons $n <nil>> n] [<cons ,(min ns2) $rs> (gcd {n @(map (lambda [$r] (mod r n)) rs)})]}))))-