egison 2.3.3 → 2.3.4

raw patch · 2 files changed

+30/−29 lines, 2 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• egison.cabal +1/−1
• hs-src/Language/Egison/Core.hs +29/−28

@@ -1,5 +1,5 @@ Name:                egison-Version:             2.3.3+Version:             2.3.4 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.

@@ -265,16 +265,14 @@ cEval1 (Closure env (MatchExpr tgtExpr typExpr mcs)) = do   tgtObjRef <- liftIO $ makeClosure env tgtExpr   typObjRef <- liftIO $ makeClosure env typExpr-  retRef <- mcLoop tgtObjRef typObjRef mcs-  cRefEval1 retRef+  mcLoop tgtObjRef typObjRef mcs  where mcLoop _ _ [] = throwError $ Default "end of match clauses"        mcLoop tgtObjRef typObjRef ((patExpr, body):rest) = do          patObjRef <- liftIO $ makeClosure env patExpr          matchs <- patternMatch MOne [(MState [] [(MAtom (PClosure [] patObjRef) tgtObjRef typObjRef)])]          case matchs of            [match] -> do newEnv <- liftIO $ extendEnv env match-                         objRef <- liftIO $ newIORef (Closure newEnv body)-                         return objRef+                         cEval1 (Closure newEnv body)            [] -> mcLoop tgtObjRef typObjRef rest cEval1 (Closure env (LoopExpr loopVar indexVar rangeExpr loopExpr tailExpr)) = do   rangeObjRef <- liftIO $ makeClosure env rangeExpr@@ -672,23 +670,29 @@ primitivePatternMatchList _ _ = throwError (Default "primitivePatternMatchList : number of patterns and targets are different")  +objectRefToInnerRefs :: ObjectRef -> IOThrowsError [InnerValRef]+objectRefToInnerRefs objRef = do+  obj <- cRefEval1 objRef+  case obj of+    Intermidiate (ICollection innerRefs) -> return innerRefs+    Value (Collection innerVals) -> do+      objRefs <- innerValsToObjRefList innerVals+      return $ map IElement objRefs+ isEmptyCollection :: ObjectRef -> IOThrowsError Bool isEmptyCollection objRef = do   obj <- cRefEval1 objRef   case obj of-    Intermidiate (ICollection innerRefs) -> isEmptyInnerRefs innerRefs+    Intermidiate (ICollection []) -> return True+    Intermidiate (ICollection ((IElement _):_)) -> return False+    Intermidiate (ICollection ((ISubCollection subObjRef):rest)) -> do+      innerRefs <- objectRefToInnerRefs subObjRef+      liftIO $ writeIORef objRef $ Intermidiate $ ICollection $ innerRefs ++ rest+      isEmptyCollection objRef+    Value (Collection []) -> return True     Value (Collection innerVals) -> isEmptyInnerVals innerVals     _ -> throwError $ Default $ "isEmptyCollection: not collection:" ++ show obj -isEmptyInnerRefs :: [InnerValRef] -> IOThrowsError Bool-isEmptyInnerRefs [] = return True-isEmptyInnerRefs ((IElement _):_) = return False-isEmptyInnerRefs ((ISubCollection objRef):rest) = do-  b <- isEmptyCollection objRef-  if b-    then isEmptyInnerRefs rest-    else return False- isEmptyInnerVals :: [InnerVal] -> IOThrowsError Bool isEmptyInnerVals [] = return True isEmptyInnerVals ((Element _):_) = return False@@ -703,21 +707,19 @@ isEmptyCollectionForSnoc objRef = do   obj <- cRefEval1 objRef   case obj of-    Intermidiate (ICollection innerRefs) -> isEmptyInnerRefsForSnoc innerRefs+    Intermidiate (ICollection ((IElement _):_)) -> return False+    Intermidiate (ICollection innerRefs) -> do+      case reverse innerRefs of+        [] -> return True+        ((IElement _):_) -> return False+        ((ISubCollection subObjRef):rest) -> do+          subInnerRefs <- objectRefToInnerRefs subObjRef+          liftIO $ writeIORef objRef $ Intermidiate $ ICollection $ reverse rest ++ reverse subInnerRefs+          isEmptyCollectionForSnoc objRef+    Value (Collection []) -> return True     Value (Collection innerVals) -> isEmptyInnerValsForSnoc innerVals     _ -> throwError $ Default $ "isEmptyCollectionForSnoc: not collection:" ++ show obj -isEmptyInnerRefsForSnoc :: [InnerValRef] -> IOThrowsError Bool-isEmptyInnerRefsForSnoc innerRefs =-  case reverse innerRefs of-    [] -> return True-    ((IElement _):_) -> return False-    ((ISubCollection objRef):rest) -> do-      b <- isEmptyCollectionForSnoc objRef-      if b-        then isEmptyInnerRefsForSnoc $ reverse rest-        else return False- isEmptyInnerValsForSnoc :: [InnerVal] -> IOThrowsError Bool isEmptyInnerValsForSnoc innerVals =   case reverse innerVals of@@ -730,7 +732,6 @@         then isEmptyInnerValsForSnoc $ reverse rest         else return False - consDestruct :: ObjectRef -> IOThrowsError (ObjectRef, ObjectRef) consDestruct objRef = do   obj <- cRefEval1 objRef@@ -812,7 +813,7 @@                 rdcObj <- liftIO $ readIORef rdcObjRef                 case rdcObj of                   Value (Collection innerVals2) -> do-                    rdcObjRef2 <- liftIO $ newIORef $ Value $ Collection $ (reverse rest) ++ [(SubCollection (Collection innerVals))]+                    rdcObjRef2 <- liftIO $ newIORef $ Value $ Collection $ (reverse rest) ++ [(SubCollection (Collection innerVals2))]                     return (racObjRef, rdcObjRef2)                   _ -> throwError $ Default "snocDestructInnerVals: cannot reach here!"