egison 2.1.12 → 2.1.13

raw patch · 3 files changed

+68/−26 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• egison.cabal +1/−1
• hs-src/Language/Egison/Core.hs +57/−25
• lib/core/collection.egi +10/−0

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

@@ -397,7 +397,7 @@         Value (Type tf) ->           let mObjRef = Data.Map.lookup ("inductive-match",[]) tf in             case mObjRef of-              Nothing -> throwError (Default "no method in type: inductiver-match")+              Nothing -> throwError (Default "no method in type: inductive-match")               Just fnObjRef ->                 do fnObj <- cRefEval1 fnObjRef                    case fnObj of@@ -419,7 +419,7 @@         Value (Type tf) ->           let mObjRef = Data.Map.lookup ("inductive-match",[]) tf in             case mObjRef of-              Nothing -> throwError (Default "no method in type: inductiver-match")+              Nothing -> throwError (Default "no method in type: inductive-match")               Just fnObjRef ->                 do fnObj <- cRefEval1 fnObjRef                    case fnObj of@@ -560,7 +560,7 @@                                     Nothing -> return Nothing                                     Just cdrFrame -> return (Just (carFrame ++ cdrFrame)) primitivePatternMatch (PSnocPat rdcPat racPat) objRef = do-  b <- isEmptyCollection objRef+  b <- isEmptyCollectionForSnoc objRef   if b     then return Nothing     else do (racObjRef, rdcObjRef) <- snocDestruct objRef@@ -612,7 +612,38 @@     then isEmptyInnerVals rest     else return False +isEmptyCollectionForSnoc :: ObjectRef -> IOThrowsError Bool+isEmptyCollectionForSnoc objRef = do+  obj <- cRefEval1 objRef+  case obj of+    Intermidiate (ICollection innerRefs) -> isEmptyInnerRefsForSnoc innerRefs+    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+    [] -> return True+    ((Element _):_) -> return False+    ((SubCollection val):rest) -> do+      objRef <- liftIO $ newIORef $ Value val+      b <- isEmptyCollectionForSnoc objRef+      if b+        then isEmptyInnerValsForSnoc $ reverse rest+        else return False++ consDestruct :: ObjectRef -> IOThrowsError (ObjectRef, ObjectRef) consDestruct objRef = do   obj <- cRefEval1 objRef@@ -663,14 +694,14 @@     _ -> throwError $ Default "snocDestruct: not collection"  snocDestructInnerRefs :: [InnerValRef] -> IOThrowsError (ObjectRef, ObjectRef)-snocDestructInnerRefs [] = throwError $ Default "snocDestructInnerRefs: empty collection" snocDestructInnerRefs innerRefs =   case reverse innerRefs of+    [] -> throwError $ Default "snocDestructInnerRefs: empty collection"     ((IElement objRef):rest) -> do-      cdrObjRef <- liftIO $ newIORef $ Intermidiate $ ICollection $ reverse rest-      return (objRef, cdrObjRef)+      rdcObjRef <- liftIO $ newIORef $ Intermidiate $ ICollection $ reverse rest+      return (objRef, rdcObjRef)     ((ISubCollection objRef):rest) -> do-      b <- isEmptyCollection objRef+      b <- isEmptyCollectionForSnoc objRef       if b         then snocDestructInnerRefs $ reverse rest         else do (racObjRef, rdcObjRef) <- snocDestruct objRef@@ -678,24 +709,25 @@                 return (racObjRef, rdcObjRef2)      snocDestructInnerVals :: [InnerVal] -> IOThrowsError (ObjectRef, ObjectRef)-snocDestructInnerVals [] = throwError $ Default "snocDestructInnerVals: empty collection"-snocDestructInnerVals ((Element val):rest) = do-  carObjRef <- liftIO $ newIORef $ Value val-  cdrObjRef <- liftIO $ newIORef $ Value $ Collection rest-  return (carObjRef, cdrObjRef)-snocDestructInnerVals ((SubCollection val):rest) = do-  objRef <- liftIO $ newIORef $ Value val-  b <- isEmptyCollection objRef-  if b-    then snocDestructInnerVals rest-    else do (carObjRef, cdrObjRef) <- snocDestruct objRef-            cdrObj <- liftIO $ readIORef cdrObjRef-            case cdrObj of-              Value (Collection innerVals) -> do-                cdrObjRef2 <- liftIO $ newIORef $ Value $ Collection $ (SubCollection (Collection innerVals)):rest-                return (carObjRef, cdrObjRef2)-              _ -> throwError $ Default "snocDestructInnerVals: cannot reach here!"-+snocDestructInnerVals innerVals =+  case reverse innerVals of+    [] -> throwError $ Default "snocDestructInnerVals: empty collection"+    ((Element val):rest) -> do+      racObjRef <- liftIO $ newIORef $ Value val+      rdcObjRef <- liftIO $ newIORef $ Value $ Collection $ reverse rest+      return (racObjRef, rdcObjRef)+    ((SubCollection val):rest) -> do+      objRef <- liftIO $ newIORef $ Value val+      b <- isEmptyCollectionForSnoc objRef+      if b+        then snocDestructInnerVals $ reverse rest+        else do (racObjRef, rdcObjRef) <- snocDestruct objRef+                rdcObj <- liftIO $ readIORef rdcObjRef+                case rdcObj of+                  Value (Collection innerVals2) -> do+                    rdcObjRef2 <- liftIO $ newIORef $ Value $ Collection $ (reverse rest) ++ [(SubCollection (Collection innerVals))]+                    return (racObjRef, rdcObjRef2)+                  _ -> throwError $ Default "snocDestructInnerVals: cannot reach here!"  collectionToObjRefList :: ObjectRef -> IOThrowsError [ObjectRef] collectionToObjRefList objRef = do

@@ -133,6 +133,16 @@     (match xs (List Something)       {[<cons _ $ys> ys]}))) +(define $rac+  (lambda [$xs]+    (match xs (List Something)+      {[<snoc $x _> x]})))++(define $rdc+  (lambda [$xs]+    (match xs (List Something)+      {[<snoc _ $ys> ys]})))+ (define $reverse   (lambda [$xs]     (match xs (List Something)