egison 1.0.7 → 1.1.0

raw patch · 5 files changed

+42/−24 lines, 5 files

Files

• Egison.hs +31/−17
• egison.cabal +1/−1
• etc/lib/graph.egi +4/−4
• etc/lib/number.egi +6/−0
• etc/sample/graph-test.egi +0/−2

@@ -11,7 +11,7 @@ import Paths_egison  welcomeMsg :: String-welcomeMsg = "Egison, version 1.0.7 : http://hagi.is.s.u-tokyo.ac.jp/~egi/egison/\nWelcome to Egison Interpreter!\n"+welcomeMsg = "Egison, version 1.1.0 : 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"@@ -264,7 +264,7 @@            | Function Environment FunPat Expression            | Expression Expression            | Macro FunPat Expression-           | Loop String String Integer Integer Expression Expression+           | Loop String String ObjectRef Expression Expression            | Type Frame            | DestructorFunction DestructInfo            | BuiltinFunction ([Value] -> IOThrowsError Value)@@ -989,7 +989,7 @@ showValue (PredPat _ _) = return "#<pred-pat>" showValue (Function _ _ _) = do   return "#<function>"-showValue (Loop _ _ _ _ _ _) = return "#<loop>"+showValue (Loop _ _ _ _ _) = return "#<loop>" showValue (Type _) = do   return "#<type>" showValue (DestructorFunction _) = do@@ -1052,7 +1052,7 @@       case maybeObjRef of         Just objRef -> do val <- cEval1 objRef                           case val of-                            Loop _ _ _ _ _ _ -> eval1Loop env val+                            Loop _ _ _ _ _ -> eval1Loop env val                             Expression expr -> do liftIO $ putStrLn "here"                                                   eval1 env expr                             _ -> return val@@ -1100,13 +1100,8 @@   objRef <- liftIO (newIORef (Closure (frame:env) body))   cEval1 objRef eval1 env expr@(LoopExp (PatVarExp var1 []) (PatVarExp var2 []) rangeExpr expr1 expr2) = do-  range <- eval env rangeExpr-  case range of-    Tuple [mObjRef,nObjRef] ->-      do m <- objectRefToInteger mObjRef-         n <- objectRefToInteger nObjRef-         eval1Loop env (Loop var1 var2 m n expr1 expr2)-    _ -> throwError (WithExpression "third arg of loop is not a range" expr)+  range <- liftIO (makeClosure env rangeExpr)+  eval1Loop env (Loop var1 var2 range expr1 expr2) eval1 env (TypeExp bind) = do   frame <- makeRecursiveFrame env bind   return (Type frame)@@ -1201,12 +1196,14 @@ evalValue val = return val     eval1Loop :: Environment -> Value -> IOThrowsError Value-eval1Loop env (Loop var1 var2 m n expr1 expr2) = do-  mObjRef <- liftIO (newIORef (Value (Integer m)))-  if m > n-     then do eval1 (([((var2,[]),mObjRef)]):env) expr2-     else do loopObjRef <- liftIO (newIORef (Value (Loop var1 var2 (m + 1) n expr1 expr2)))-             eval1 ([((var1,[]),loopObjRef),((var2,[]),mObjRef)]:env) expr1+eval1Loop env (Loop var1 var2 range expr1 expr2) = do+  rVal <- cEval1 range+  b <- isEmptyCollection rVal+  if b+    then do eval1 env expr2+    else do (carObjRef,cdrObjRef) <- consDestruct rVal+            loopObjRef <- liftIO (newIORef (Value (Loop var1 var2 cdrObjRef expr1 expr2)))+            eval1 ([((var1,[]),loopObjRef),((var2,[]),carObjRef)]:env) expr1 eval1Loop _ _ = throwError (Default "eval1Loop")  evalInnerVals :: [InnerValue] -> IOThrowsError ()@@ -1587,6 +1584,8 @@     "print" -> Just builtinPrint     "read-char" -> Just builtinReadChar     "write-char" -> Just builtinWriteChar+    "=c" -> Just builtinEqualCharacter+    "compare-character" -> Just builtinCompareCharacter     "int-to-float" -> Just builtinIntToFloat     "ceiling" -> Just builtinCeiling     "floor" -> Just builtinFloor@@ -1659,6 +1658,21 @@   liftIO (putChar c)   return (World ((Write (Character c)):actions)) builtinWriteChar _ = throwError (Default "invalid args to write-char")+++builtinEqualCharacter :: [Value] -> IOThrowsError Value+builtinEqualCharacter [(Character c1), (Character c2)] =  if (c1 == c2)+                                                            then return (InductiveData "true" [])+                                                            else return (InductiveData "false" [])+builtinEqualCharacter _ = throwError (Default "invalid args to =c")++builtinCompareCharacter :: [Value] -> IOThrowsError Value+builtinCompareCharacter [(Character c1), (Character c2)] =  if (c1 == c2)+                                                              then return (InductiveData "equal" [])+                                                              else if (c1 < c2)+                                                                     then return (InductiveData "less" [])+                                                                     else return (InductiveData "greater" [])+builtinCompareCharacter _ = throwError (Default "invalid args to compare-character")   builtinIntToFloat :: [Value] -> IOThrowsError Value

@@ -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:             1.0.7+Version:             1.1.0  -- A short (one-line) description of the package. Synopsis:            An Interpreter for the Programming Language Egison

@@ -20,12 +20,12 @@     (let {[$n (size g)]}       (match-all g Graph         [<cons <node $a_1 <cons $a_2 _> _>-               (loop $l $i [3 n]+               (loop $l $i (between 3 n)                      <cons <node ,a_(- i 1) <cons $a_i _> _>                            l>                      <cons <node ,a_n <cons ,a_1 _> _>                            _>)>-         [@(loop $l $i [1 n] {a_i @l} {})]+         [@(loop $l $i (between 1 n) {a_i @l} {})]          ]))))  (define $hamilton-path@@ -33,11 +33,11 @@     (let {[$n (size g)]}       (match-all g Graph         [<cons <node $a_1 <cons $a_2 _> _>-               (loop $l $i [3 n]+               (loop $l $i (between 3 n)                      <cons <node ,a_(- i 1) <cons $a_i _> _>                            l>                      <cons <node ,a_n _ _>                            <nil>>)>-         [@(loop $l $i [1 n] {a_i @l} {})]+         [@(loop $l $i (between 1 n) {a_i @l} {})]          ])))) 

@@ -21,3 +21,9 @@                    {[<greater> {(- tgt 1)}]                     [_ {}]})]}]})]      [$equal? (lambda [$val $tgt] (= val tgt))]}))++(define $between+  (lambda [$m $n]+    (match (compare-integer m n) Order+      {[<less> {m @(between (+ m 1) n)}]+       [<equal> {n}]})))

@@ -10,7 +10,6 @@              <node 4 {1 3 5} {1 3 5}>              <node 5 {1 5} {1 5}>}) - (test (match-all g Graph         [<cons <node $n1 <cons $n2 _> _>           <cons <node ,n2 <cons $n3 _> _>@@ -35,7 +34,6 @@              <cons <node ,n5 _ _>               <nil>>>>>>          [n1 n2 n3 n4 n5]]))-  (test (hamilton-cycle g2))