egison 0.2.0.2 → 0.2.1.0
raw patch · 3 files changed
+134/−12 lines, 3 files
Files
- Egison.hs +117/−8
- egison.cabal +1/−1
- etc/sample/collection-test.egi +16/−3
Egison.hs view
@@ -11,7 +11,7 @@ main :: IO () main = do args <- getArgs case length args of- 0 -> do flushStr "Egison, version 0.2.0.2 : http://hagi.is.s.u-tokyo.ac.jp/~egi/egison/\nWelcome to Egison Interpreter!\n"+ 0 -> do flushStr "Egison, version 0.2.1.0 : http://hagi.is.s.u-tokyo.ac.jp/~egi/egison/\nWelcome to Egison Interpreter!\n" defsRef <- newIORef [] runRepl defsRef _ -> putStrLn "Program takes only 0 argument!"@@ -1257,6 +1257,29 @@ "*" -> Just builtinMultiply "/" -> Just builtinDevide "mod" -> Just builtinMod+ "=f" -> Just builtinEqualFloat+ "+f" -> Just builtinPlusFloat+ "-f" -> Just builtinMinusFloat+ "*f" -> Just builtinMultiplyFloat+ "/f" -> Just builtinDevideFloat+-- "pi" -> Just builtinPi+ "exp" -> Just builtinExp+ "log" -> Just builtinLog+ "sqrt" -> Just builtinSqrt+ "**" -> Just builtinPower+ "log-base" -> Just builtinLogBase+ "sin" -> Just builtinSin+ "cos" -> Just builtinCos+ "tan" -> Just builtinTan+ "asin" -> Just builtinAsin+ "acos" -> Just builtinAcos+ "atan" -> Just builtinAtan+ "sinh" -> Just builtinSinh+ "cosh" -> Just builtinCosh+ "tanh" -> Just builtinTanh+ "asinh" -> Just builtinAsinh+ "acosh" -> Just builtinAcosh+ "atanh" -> Just builtinAtanh _ -> Nothing builtinRead :: [Value] -> IOThrowsError Value@@ -1287,38 +1310,124 @@ return (World ((Write (Character c)):actions)) builtinWriteChar _ = throwError (Default "invalid args to write-char") + builtinEqual :: [Value] -> IOThrowsError Value builtinEqual [(Integer n1), (Integer n2)] = if (n1 == n2) then return (InductiveData "true" []) else return (InductiveData "false" [])-builtinEqual [(Double n1), (Double n2)] = if (n1 == n2)- then return (InductiveData "true" [])- else return (InductiveData "false" []) builtinEqual _ = throwError (Default "invalid args to =") builtinPlus :: [Value] -> IOThrowsError Value builtinPlus [(Integer n1), (Integer n2)] = return (Integer (n1 + n2))-builtinPlus [(Double n1), (Double n2)] = return (Double (n1 + n2)) builtinPlus _ = throwError (Default "invalid args to +") builtinMinus :: [Value] -> IOThrowsError Value builtinMinus [(Integer n1), (Integer n2)] = return (Integer (n1 - n2))-builtinMinus [(Double n1), (Double n2)] = return (Double (n1 - n2)) builtinMinus _ = throwError (Default "invalid args to -") builtinMultiply :: [Value] -> IOThrowsError Value builtinMultiply [(Integer n1), (Integer n2)] = return (Integer (n1 * n2))-builtinMultiply [(Double n1), (Double n2)] = return (Double (n1 * n2)) builtinMultiply _ = throwError (Default "invalid args to *") builtinDevide :: [Value] -> IOThrowsError Value builtinDevide [(Integer n1), (Integer n2)] = return (Integer (div n1 n2))-builtinDevide [(Double n1), (Double n2)] = return (Double (n1 / n2)) builtinDevide _ = throwError (Default "invalid args to /") builtinMod :: [Value] -> IOThrowsError Value builtinMod [(Integer n1), (Integer n2)] = return (Integer (mod n1 n2)) builtinMod _ = throwError (Default "invalid args to mod")+++builtinEqualFloat :: [Value] -> IOThrowsError Value+builtinEqualFloat [(Double n1), (Double n2)] = if (n1 == n2)+ then return (InductiveData "true" [])+ else return (InductiveData "false" [])+builtinEqualFloat _ = throwError (Default "invalid args to =f")++builtinPlusFloat :: [Value] -> IOThrowsError Value+builtinPlusFloat [(Double n1), (Double n2)] = return (Double (n1 + n2))+builtinPlusFloat _ = throwError (Default "invalid args to +f")++builtinMinusFloat :: [Value] -> IOThrowsError Value+builtinMinusFloat [(Double n1), (Double n2)] = return (Double (n1 - n2))+builtinMinusFloat _ = throwError (Default "invalid args to -f")++builtinMultiplyFloat :: [Value] -> IOThrowsError Value+builtinMultiplyFloat [(Double n1), (Double n2)] = return (Double (n1 * n2))+builtinMultiplyFloat _ = throwError (Default "invalid args to *f")++builtinDevideFloat :: [Value] -> IOThrowsError Value+builtinDevideFloat [(Double n1), (Double n2)] = return (Double (n1 / n2))+builtinDevideFloat _ = throwError (Default "invalid args to /f")+++builtinExp :: [Value] -> IOThrowsError Value+builtinExp [Double d] = return (Double (exp d))+builtinExp _ = throwError (Default "invalid args to exp")++builtinLog :: [Value] -> IOThrowsError Value+builtinLog [Double d] = return (Double (log d))+builtinLog _ = throwError (Default "invalid args to log")++builtinSqrt :: [Value] -> IOThrowsError Value+builtinSqrt [Double d] = return (Double (sqrt d))+builtinSqrt _ = throwError (Default "invalid args to sqrt")++builtinPower :: [Value] -> IOThrowsError Value+builtinPower [(Double n1), (Double n2)] = return (Double (n1 ** n2))+builtinPower _ = throwError (Default "invalid args to **")++builtinLogBase :: [Value] -> IOThrowsError Value+builtinLogBase [(Double n1), (Double n2)] = return (Double (logBase n1 n2))+builtinLogBase _ = throwError (Default "invalid args to log-base")++builtinSin :: [Value] -> IOThrowsError Value+builtinSin [Double d] = return (Double (sin d))+builtinSin _ = throwError (Default "invalid args to sin")++builtinCos :: [Value] -> IOThrowsError Value+builtinCos [Double d] = return (Double (cos d))+builtinCos _ = throwError (Default "invalid args to cos")++builtinTan :: [Value] -> IOThrowsError Value+builtinTan [Double d] = return (Double (tan d))+builtinTan _ = throwError (Default "invalid args to tan")++builtinAsin :: [Value] -> IOThrowsError Value+builtinAsin [Double d] = return (Double (asin d))+builtinAsin _ = throwError (Default "invalid args to asin")++builtinAcos :: [Value] -> IOThrowsError Value+builtinAcos [Double d] = return (Double (acos d))+builtinAcos _ = throwError (Default "invalid args to acos")++builtinAtan :: [Value] -> IOThrowsError Value+builtinAtan [Double d] = return (Double (atan d))+builtinAtan _ = throwError (Default "invalid args to atan")++builtinSinh :: [Value] -> IOThrowsError Value+builtinSinh [Double d] = return (Double (sinh d))+builtinSinh _ = throwError (Default "invalid args to sinh")++builtinCosh :: [Value] -> IOThrowsError Value+builtinCosh [Double d] = return (Double (cosh d))+builtinCosh _ = throwError (Default "invalid args to cosh")++builtinTanh :: [Value] -> IOThrowsError Value+builtinTanh [Double d] = return (Double (tanh d))+builtinTanh _ = throwError (Default "invalid args to tanh")++builtinAsinh :: [Value] -> IOThrowsError Value+builtinAsinh [Double d] = return (Double (asinh d))+builtinAsinh _ = throwError (Default "invalid args to asinh")++builtinAcosh :: [Value] -> IOThrowsError Value+builtinAcosh [Double d] = return (Double (acosh d))+builtinAcosh _ = throwError (Default "invalid args to acosh")++builtinAtanh :: [Value] -> IOThrowsError Value+builtinAtanh [Double d] = return (Double (atanh d))+builtinAtanh _ = throwError (Default "invalid args to atanh") --- --- for Debug : show Expression
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.2.0.2+Version: 0.2.1.0 -- A short (one-line) description of the package. Synopsis: An Interpreter for the Programming Language Egison
etc/sample/collection-test.egi view
@@ -196,6 +196,13 @@ {[<nil> xs] [<cons $y $rs> ((remove-collection a) ((remove a) xs y) rs)]})))) +(define $add+ (lambda [$a]+ (lambda [$xs $x]+ (match ((member? Int) x xs) Bool+ {[<true> xs]+ [<false> {@xs x}]}))))+ (define $subcollections (lambda [$xs] (match xs (List Something)@@ -362,7 +369,7 @@ }] [cons [a Loop] {[[$ts1 $ts2] (map (lambda [$t] [t [((remove a) ts1 t)- {@ts2 t}]])+ (add @ts2 t)]]) {@ts1 @ts2})] }] [join [(Set a) Loop]@@ -374,7 +381,7 @@ [$equal? <undefined>] })]} (type- {[$var-match (lambda [$tgt] {$tgt})]+ {[$var-match (lambda [$tgt] {tgt})] [$inductive-match (lambda [$tgt] (let {[$tgt2 ((unique a) tgt)]}@@ -427,7 +434,13 @@ (test (match-all {<x> <y> <z>} (List Something) [<nioj $xs $ys> [xs ys]])) -(test (match-all {<x> <y> <z> <w>} (List Something)+(test (match-all {1 2 3} (List Int)+ [<join $hs <cons $x $ts>> [hs x ts]]))++(test (match-all {1 2 3} (Multiset Int)+ [<join $hs <cons $x $ts>> [hs x ts]]))++(test (match-all {1 2 3} (Set Int) [<join $hs <cons $x $ts>> [hs x ts]])) (test ((remove-collection Suit) {<club> <heart> <diamond>} {<club> <diamond>}))