egison 2.3.10 → 2.4.0

raw patch · 12 files changed

+147/−129 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• egison.cabal +1/−1
• elisp/egison-mode.el +1/−0
• hs-src/Language/Egison/Core.hs +73/−62
• hs-src/Language/Egison/Macro.hs +8/−4
• hs-src/Language/Egison/Numerical.hs +0/−16
• hs-src/Language/Egison/Parser.hs +7/−9
• hs-src/Language/Egison/Primitives.hs +2/−2
• hs-src/Language/Egison/Types.hs +10/−6
• lib/core/collection.egi +41/−25
• lib/core/number.egi +1/−1
• lib/graph.egi +2/−2
• sample/n-queen.egi +1/−1

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

@@ -19,6 +19,7 @@      "\\<match-all\\>"      "\\<generate-array\\>" +     "\\<undefined\\>"      "\\<Something\\>"            "\\\."

@@ -11,7 +11,6 @@ import qualified System.Exit () import System.Directory (doesFileExist) import System.IO-import System.IO.Strict (SIO) import qualified System.IO.Strict as SIO import Data.IORef import Data.Version@@ -63,7 +62,7 @@   argv <- cEval1 $ Closure env argvExpr   argvRef <- liftIO $ newIORef argv   worldRef <- liftIO $ newIORef $ Value $ World []-  argsRef <- liftIO $ newIORef $ Intermidiate $ ITuple $ [IElement worldRef, IElement argvRef]+  argsRef <- liftIO $ newIORef $ Intermidiate $ ITuple $ [worldRef, argvRef]   ret <- cApply1 mainRef argsRef   cEval ret @@ -112,9 +111,9 @@ iEval (ICollection innerRefs) = do   vals <- innerRefsEval innerRefs   return $ Collection vals-iEval (ITuple innerRefs) = do-  innerVals <- innerRefsEval innerRefs-  return $ Tuple innerVals+iEval (ITuple objRefs) = do+  vals <- mapM cRefEval objRefs+  return $ Tuple vals  innerRefsEval :: [InnerValRef] -> IOThrowsError [EgisonVal] innerRefsEval [] = return []@@ -178,12 +177,11 @@   return $ Intermidiate $ IInductiveData cons args cEval1 (Closure _ (TupleExpr [])) = do   return $ Value $ Tuple []-cEval1 (Closure env (TupleExpr innerExprs)) = do-  innerRefs <- liftIO $ mapM (makeInnerValRef env) innerExprs-  objRefs <- innerRefsToObjRefs innerRefs+cEval1 (Closure env (TupleExpr exprs)) = do+  objRefs <- liftIO $ mapM (makeClosure env) exprs   case objRefs of     [objRef] -> cRefEval1 objRef-    _ -> return $ Intermidiate $ ITuple innerRefs+    _ -> return $ Intermidiate $ ITuple objRefs cEval1 (Closure env (CollectionExpr innerExprs)) = do   innerRefs <- liftIO $ mapM (makeInnerValRef env) innerExprs   return $ Intermidiate $ ICollection innerRefs@@ -238,7 +236,8 @@   patObjRefs <- liftIO $ mapM (makeClosure env) patExprs   return $ Value $ AndPat patObjRefs cEval1 (Closure env (FuncExpr args body)) = do-  return $ Value $ Func args body env+  argsObjRef <- liftIO $ makeClosure env args+  return $ Value $ Func argsObjRef body env cEval1 (Closure _ (MacroExpr args body)) = do   return $ Value $ Macro args body cEval1 (Closure env (IfExpr condExpr expr1 expr2)) = do@@ -312,7 +311,8 @@     Value (PrimitiveFunc fn) -> do arg <- eval env argExpr                                    val <- liftThrows $ fn (tupleToList arg)                                    return $ Value val-    Value (Func fArgs body cEnv) -> do frame <- liftIO (makeClosure env argExpr) >>= makeFrame fArgs+    Value (Func fArgs body cEnv) -> do argObjRef <- liftIO $ makeClosure env argExpr+                                       frame <- makeFrame fArgs argObjRef                                        newEnv <- liftIO $ extendEnv cEnv frame                                        cEval1 (Closure newEnv body)     Value (Macro mArgs body) -> do argExprs <- liftThrows $ tupleExprToExprList argExpr@@ -320,6 +320,8 @@                                    liftIO $ putStrLn $ showExpr newBody                                    cEval1 (Closure env newBody)     _ -> throwError $ Default "not function"+cEval1 (Closure _ UndefinedExpr) = do+  throwError ReachToUndefined cEval1 val = do   return val @@ -366,47 +368,39 @@             cEval1 $ Closure newEnv loopExpr expandLoop _ obj = throwError $ Default $ "expandLoop: cannot reach here: " ++ show obj            --- |Extend given environment by binding a series of values to a new environment for let. extendLet :: Env -- ^ Environment -          -> [(Args, EgisonExpr)] -- ^ Extensions to the environment+          -> [(EgisonExpr, EgisonExpr)] -- ^ Extensions to the environment           -> IOThrowsError Env -- ^ Extended environment-extendLet env abindings = do-  bingingList <- liftM concat $ mapM (\(args, expr) -> do-                                         objRef <- liftIO $ makeClosure env expr-                                         helper args objRef)-                      abindings-  liftIO $ extendEnv env bingingList- where helper (AVar name) objRef = return [((name, []), objRef)]-       helper (ATuple argss) objRef = do-         obj <- cRefEval1 objRef-         case obj of-           Intermidiate (ITuple innerRefs) -> do-             objRefs <- innerValRefsToObjRefs innerRefs-             liftM concat $ mapM (\(args,objRef3) -> helper args objRef3) $ zip argss objRefs-           Value (Tuple vals) -> do-             objRefs <- liftIO $ mapM (newIORef . Value) vals-             liftM concat $ mapM (\(args,objRef3) -> helper args objRef3) $ zip argss objRefs-           _ -> liftM concat $ mapM (\(args,objRef3) -> helper args objRef3) $ zip argss [objRef]+extendLet env binding = do+ frame <- helper binding+ liftIO $ extendEnv env frame+ where helper :: [(EgisonExpr, EgisonExpr)] -> IOThrowsError FrameList+       helper [] = return []+       helper ((patExpr, tgtExpr):rest) = do+         patObjRef <- liftIO $ makeClosure env patExpr+         tgtObjRef <- liftIO $ makeClosure env tgtExpr+         frame <- makeFrame patObjRef tgtObjRef+         retRest <- helper rest+         return $ frame ++ retRest -makeFrame :: Args -> ObjectRef -> IOThrowsError [(Var, ObjectRef)]-makeFrame (AVar name) objRef = return $ [((name,[]), objRef)]-makeFrame (ATuple []) _ = return $ []-makeFrame (ATuple [fArg]) objRef = makeFrame fArg objRef-makeFrame (ATuple fArgs) objRef = do-  obj <- cRefEval1 objRef-  case obj of-    Intermidiate (ITuple innerRefs) -> do-      objRefs <- innerValRefsToObjRefs innerRefs-      frames <- mapM (\(fArg,objRef3) -> makeFrame fArg objRef3) $ zip fArgs objRefs-      return $ concat frames-    Value (Tuple vals) -> do-      objRefs <- liftIO $ mapM (newIORef . Value) vals-      frames <- mapM (\(fArg,objRef3) -> makeFrame fArg objRef3) $ zip fArgs objRefs-      return $ concat frames-    _ -> throwError $ Default "makeFrame: not tuple"+makeFrame :: ObjectRef -> ObjectRef -> IOThrowsError FrameList+makeFrame patObjRef tgtObjRef = do+  patObjRefs <- tupleToObjRefs patObjRef+  let n = length patObjRefs+  if n == 1+    then do typObjRef <- liftIO $ newIORef $ Value Something+            matchs <- patternMatch MOne [(MState [] [(MAtom (PClosure [] patObjRef) tgtObjRef typObjRef)])]           +            case matchs of+              [match] -> return match+              _ -> throwError $ Default "makeFrame: binding error"+    else do typObjRef <- liftIO $ newIORef $ (Value . Tuple) $ replicate (length patObjRefs) Something+            matchs <- patternMatch MOne [(MState [] [(MAtom (PClosure [] patObjRef) tgtObjRef typObjRef)])]           +            case matchs of+              [match] -> do return match+              _ -> throwError $ Default "makeFrame: binding error"  tupleExprToExprList :: EgisonExpr -> ThrowsError [EgisonExpr]-tupleExprToExprList (TupleExpr innerExprs) = innerExprsToExprList innerExprs+tupleExprToExprList (TupleExpr exprs) = return exprs tupleExprToExprList expr = return [expr]  innerExprsToExprList :: [InnerExpr] -> ThrowsError [EgisonExpr]@@ -504,18 +498,35 @@                                       inTgtObjRefss) ++ states)         Value Something -> throwError $ Default "patternMatch: Only pattern variable can be pattern matched with Something"         _ -> throwError $ Default "patternMatch: second argument of match expressions must be type"-    Intermidiate (ITuple pats) -> do-      patObjRefs <- innerRefsToObjRefs pats-      tgtObjRefs <- tupleToObjRefs tgtObjRef+    Intermidiate (ITuple patObjRefs) -> do       typObjRefs <- tupleToObjRefs typObjRef-      patternMatch flag $ (MState frame ((map (\(pat,tgt,typ) -> MAtom (PClosure bf pat) tgt typ) (zip3 patObjRefs tgtObjRefs typObjRefs)) ++ atoms)):states+      if length typObjRefs == 1+        then do+          let tgtObjRefs = [tgtObjRef]+          if (length typObjRefs == length patObjRefs) && (length typObjRefs == length tgtObjRefs)+            then patternMatch flag $ (MState frame ((map (\(pat,tgt,typ) -> MAtom (PClosure bf pat) tgt typ) (zip3 patObjRefs tgtObjRefs typObjRefs)) ++ atoms)):states+            else throwError $ Default "patternMatch: number of types, patterns and targets are different"+        else do+          tgtObjRefs <- tupleToObjRefs tgtObjRef+          if (length typObjRefs == length patObjRefs) && (length typObjRefs == length tgtObjRefs)+            then patternMatch flag $ (MState frame ((map (\(pat,tgt,typ) -> MAtom (PClosure bf pat) tgt typ) (zip3 patObjRefs tgtObjRefs typObjRefs)) ++ atoms)):states+            else throwError $ Default "patternMatch: number of types, patterns and targets are different"     Value (Tuple pats) -> do       patObjRefs <- liftIO $ mapM (newIORef . Value) pats-      tgtObjRefs <- tupleToObjRefs tgtObjRef       typObjRefs <- tupleToObjRefs typObjRef-      patternMatch flag $ (MState frame ((map (\(pat,tgt,typ) -> MAtom (PClosure bf pat) tgt typ) (zip3 patObjRefs tgtObjRefs typObjRefs)) ++ atoms)):states+      if length typObjRefs == 1+        then do+          let tgtObjRefs = [tgtObjRef]+          if (length typObjRefs == length patObjRefs) && (length typObjRefs == length tgtObjRefs)+            then patternMatch flag $ (MState frame ((map (\(pat,tgt,typ) -> MAtom (PClosure bf pat) tgt typ) (zip3 patObjRefs tgtObjRefs typObjRefs)) ++ atoms)):states+            else throwError $ Default "patternMatch: number of types, patterns and targets are different"+        else do+          tgtObjRefs <- tupleToObjRefs tgtObjRef+          if (length typObjRefs == length patObjRefs) && (length typObjRefs == length tgtObjRefs)+            then patternMatch flag $ (MState frame ((map (\(pat,tgt,typ) -> MAtom (PClosure bf pat) tgt typ) (zip3 patObjRefs tgtObjRefs typObjRefs)) ++ atoms)):states+            else throwError $ Default "patternMatch: number of types, patterns and targets are different"     Value (PredPat predObjRef patObjRefs) -> do-      argsObjRef <- liftIO $ newIORef $ Intermidiate $ ITuple $ map IElement $ patObjRefs ++ [tgtObjRef]+      argsObjRef <- liftIO $ newIORef $ Intermidiate $ ITuple $ patObjRefs ++ [tgtObjRef]       ret <- cApply1 predObjRef argsObjRef       case ret of         Value (Bool True) -> patternMatch flag ((MState frame atoms):states)@@ -551,9 +562,13 @@       mPpmRet <- helper pclss       case mPpmRet of         Nothing -> throwError $ Default "inductiveMatch: not matched any primitive clauses"-        Just tgtObjRefss -> do+        Just tgtObjRefs -> do           typObjRefs <- tupleToObjRefs typObjRef-          return (typObjRefs, patObjRefs, tgtObjRefss)+          if length typObjRefs == 1+            then do let tgtObjRefss = map (\x -> [x]) tgtObjRefs+                    return (typObjRefs, patObjRefs, tgtObjRefss)+            else do tgtObjRefss <- mapM tupleToObjRefs tgtObjRefs+                    return (typObjRefs, patObjRefs, tgtObjRefss)      where helper [] = return Nothing            helper ((env, ppat, expr):pclss2) = do              mPpmRet <- primitivePatternMatch ppat tgtObjRef@@ -563,8 +578,7 @@                  newEnv <- liftIO $ extendEnv env (ppmRet ++ frame)                  retObjRef <- liftIO $ makeClosure newEnv expr                  tgtObjRefs <- collectionToObjRefs retObjRef-                 tgtObjRefss <- mapM tupleToObjRefs tgtObjRefs-                 return $ Just tgtObjRefss+                 return $ Just tgtObjRefs  primitivePatPatternMatch :: PrimitivePatPattern -> ObjectRef -> IOThrowsError (Maybe ([ObjectRef], FrameList)) primitivePatPatternMatch PPWildCard patObjRef = return $ Just ([patObjRef], [])@@ -783,7 +797,7 @@ tupleToObjRefs objRef = do   obj <- cRefEval1 objRef   case obj of-    Intermidiate (ITuple innerRefs) -> innerRefsToObjRefs innerRefs+    Intermidiate (ITuple objRefs) -> return objRefs     Value (Tuple vals) -> liftIO $ mapM (newIORef . Value) vals     _ -> return [objRef] @@ -905,9 +919,6 @@                              ("&&", boolBinop (&&)),               ("||", boolBinop (||)),--              ("tuple-to-collection", tupleToCollection),-              ("collection-to-tuple", collectionToTuple),                ("array-dimension", arrayDimension),               ("array-range", arrayRange),

@@ -10,7 +10,7 @@ expandMacro :: MacroFrame -> EgisonExpr -> IOThrowsError EgisonExpr expandMacro frame (VarExpr name []) =   case getExpr frame name of-    Nothing -> return $ MacroVarExpr name []+    Nothing -> return $ VarExpr name []     Just expr -> return expr expandMacro frame (PatVarOmitExpr expr) = do   newExpr <- expandMacro frame expr@@ -25,9 +25,9 @@ expandMacro frame (InductiveDataExpr cons exprs) = do   newExprs <- mapM (expandMacro frame) exprs   return $ InductiveDataExpr cons newExprs-expandMacro frame (TupleExpr innerExprs) = do-  newInnerExprs <- mapM (expandMacroInnerExpr frame) innerExprs-  return $ TupleExpr newInnerExprs+expandMacro frame (TupleExpr exprs) = do+  newExprs <- mapM (expandMacro frame) exprs+  return $ TupleExpr newExprs expandMacro frame (CollectionExpr innerExprs) = do   newInnerExprs <- mapM (expandMacroInnerExpr frame) innerExprs   return $ CollectionExpr newInnerExprs@@ -75,6 +75,10 @@   newTypExpr <- expandMacro frame typExpr   newMc <- expandMacroMatchClause frame mc   return $ MatchAllExpr newTgtExpr newTypExpr newMc+expandMacro frame (ApplyExpr opExpr argExpr) = do+  newOpExpr <- expandMacro frame opExpr+  newArgExpr <- expandMacro frame argExpr+  return $ ApplyExpr newOpExpr newArgExpr expandMacro _ expr = return expr  expandMacroMatchClause :: MacroFrame -> MatchClause -> IOThrowsError MatchClause

@@ -1,10 +1,6 @@ module Language.Egison.Numerical where import Language.Egison.Types import Control.Monad.Error---import Data.Char hiding (isNumber)---import Data.Fixed---import Numeric---import Text.Printf import Data.Array  boolBinop :: (Bool -> Bool -> Bool) -> [EgisonVal] -> ThrowsError EgisonVal@@ -162,18 +158,6 @@ unpackFloat :: EgisonVal -> ThrowsError Double unpackFloat (Float n) = return n unpackFloat notFloat = throwError $ TypeMismatch "float" [notFloat]---tupleToCollection :: [EgisonVal] -> ThrowsError EgisonVal-tupleToCollection vals = return $ Collection $ vals--collectionToTuple :: [EgisonVal] -> ThrowsError EgisonVal-collectionToTuple [(Collection vals)] = do-  case vals of-    [val] -> return val-    _ -> return $ Tuple vals-collectionToTuple [x] = throwError $ TypeMismatch "collection" [x]-collectionToTuple badArgList = throwError $ NumArgs 1 badArgList  stringToChars :: [EgisonVal] -> ThrowsError EgisonVal stringToChars [(String str)] = return $ Collection $ map Char str

@@ -2,13 +2,9 @@ import Language.Egison.Types import Control.Monad.Error import qualified Data.Char as Char-import Data.Complex-import Data.Array import Numeric-import Data.Ratio import Text.ParserCombinators.Parsec hiding (spaces) import Text.Parsec.Language-import Text.Parsec.Prim (ParsecT) import qualified Text.Parsec.Token as P  egisonDef :: LanguageDef ()@@ -256,7 +252,7 @@                      parseBindings :: Parser Bindings parseBindings = do-  braces (do sepEndBy (brackets (do args <- lexeme parseArgs+  braces (do sepEndBy (brackets (do args <- lexeme parseExpr                                     expr <- lexeme parseExpr                                     return (args, expr)))                       whiteSpace)@@ -404,6 +400,8 @@   <|> lexeme parseMacroVarExpr   <|> lexeme parsePatVarOmitExpr   <|> lexeme parseVarOmitExpr+  <|> try (lexeme (do string "undefined"+                      return UndefinedExpr))   <|> try (lexeme (do string "Something"                       return SomethingExpr))   <|> lexeme parseVar@@ -416,10 +414,10 @@                  return $ InductiveDataExpr cons argExprs)   <|> braces (do innerExprs <- sepEndBy parseInnerExpr whiteSpace                  return $ CollectionExpr innerExprs)-  <|> brackets (do innerExprs <- sepEndBy parseInnerExpr whiteSpace-                   return $ TupleExpr innerExprs)+  <|> brackets (do exprs <- sepEndBy parseExpr whiteSpace+                   return $ TupleExpr exprs)   <|> parens (do try (string "lambda" >> many1 space)-                 args <- lexeme parseArgs+                 args <- lexeme parseExpr                  body <- lexeme parseExpr                  return (FuncExpr args body)           <|> do try (string "macro" >> many1 space)@@ -471,7 +469,7 @@                  return (GenerateArrayExpr fnExpr arrExpr)           <|> do opExpr <- lexeme parseExpr                  argExprs <- sepEndBy parseExpr whiteSpace-                 return (ApplyExpr opExpr (TupleExpr (map ElementExpr argExprs))))+                 return (ApplyExpr opExpr (TupleExpr argExprs)))   <?> "Expression"  parseTopExpr :: Parser TopExpr

@@ -234,8 +234,8 @@ exprToVal (CollectionExpr innerExprs) = do   vals <- innerExprsToVals innerExprs   return $ Collection vals-exprToVal (TupleExpr innerExprs) = do-  vals <- innerExprsToVals innerExprs+exprToVal (TupleExpr exprs) = do+  vals <- mapM exprToVal exprs   return $ Tuple vals exprToVal _ = throwError $ Default "read: invalid value" 

@@ -17,6 +17,7 @@   | NotFunction String String   | UnboundVar String String   | DivideByZero+  | ReachToUndefined   | NotImplemented String   | InternalError String   | Default String@@ -30,7 +31,8 @@ showError (BadSpecialForm message args) = message ++ ": " ++ unwordsList args showError (NotFunction message func) = message ++ ": " ++ show func showError (UnboundVar message varname) = message ++ ": " ++ varname-showError (DivideByZero) = "Division by zero"+showError DivideByZero = "Division by zero"+showError ReachToUndefined = "Reached to undefined" showError (NotImplemented message) = "Not implemented: " ++ message showError (InternalError message) = "An internal error occurred: " ++ message showError (Default message) = "Error: " ++ message@@ -93,10 +95,10 @@   | OrPatExpr [EgisonExpr]   | PredPatExpr EgisonExpr [EgisonExpr]   | InductiveDataExpr String [EgisonExpr]-  | TupleExpr [InnerExpr]+  | TupleExpr [EgisonExpr]   | CollectionExpr [InnerExpr]   | ArrayExpr [ArrayElementExpr]-  | FuncExpr Args EgisonExpr+  | FuncExpr EgisonExpr EgisonExpr   | MacroExpr [String] EgisonExpr   | LoopExpr String String EgisonExpr EgisonExpr EgisonExpr   | ParamsExpr String EgisonExpr EgisonExpr@@ -110,6 +112,7 @@   | GenerateArrayExpr EgisonExpr EgisonExpr   | ApplyExpr EgisonExpr EgisonExpr   | SomethingExpr+  | UndefinedExpr  deriving (Show)  data ArrayElementExpr = AElementExpr EgisonExpr@@ -141,7 +144,7 @@   | SubCollectionExpr EgisonExpr  deriving (Show) -type Bindings = [(Args, EgisonExpr)]+type Bindings = [(EgisonExpr, EgisonExpr)]  type RecursiveBindings = [(String, EgisonExpr)]   @@ -176,7 +179,7 @@   | Collection [EgisonVal]   | Array Integer [Integer] (Array Integer EgisonVal)   | Type DestructInfo-  | Func Args EgisonExpr Env+  | Func ObjectRef EgisonExpr Env   | Macro [String] EgisonExpr   | PrimitiveFunc ([EgisonVal] -> ThrowsError EgisonVal)   | IOFunc ([EgisonVal] -> IOThrowsError EgisonVal)@@ -185,7 +188,7 @@   | EOF  data IntermidiateVal = IInductiveData String [ObjectRef]-  | ITuple [InnerValRef]+  | ITuple [ObjectRef]   | ICollection [InnerValRef]    data Action = OpenInputPort String@@ -337,6 +340,7 @@ showExpr (ApplyExpr opExpr argExpr) =   "(" ++ showExpr opExpr ++ " " ++ showExpr argExpr ++ ")" showExpr SomethingExpr = "Something"+showExpr UndefinedExpr = "undefined"  ---- |Allow conversion of egisonexpr instances to strings --instance Show EgisonExpr where show = showExpr

@@ -34,20 +34,20 @@                                       [[_ _] {}]}))]}                  (helper pys tgt))]}]        [<join _ _> [(List a) (List a)]-		{[$tgt (letrec {[$helper (lambda [$xs $ys $r]+		{[$tgt (letrec {[$helper (lambda [$xs $ys] 								   (match ys (List a)-									 {[<nil> {[xs {}] @r}]-									  [<cons $z $zs> (helper {@xs z} zs {[xs ys] @r})]}))]}-				 (helper {} tgt {}))]}]+									 {[<nil> {[xs {}]}]+									  [<cons $z $zs> {[xs ys] @(helper {@xs z} zs {[xs ys]})}]}))]}+				 (helper {} tgt))]}]        [<nioj ,$pxs _> [(List a)]         {[$tgt (match-all tgt (List a) [<join $ys ,pxs> ys])]}]        [<nioj _ ,$pys> [(List a)]         {[$tgt (match-all tgt (List a) [<join ,pys $xs> xs])]}]        [<nioj _ _> [(List a) (List a)]-		{[$tgt (letrec {[$helper (lambda [$xs $ys $r]+		{[$tgt (letrec {[$helper (lambda [$xs $ys] 								   (match ys (List a)-									 {[<nil> {[{} xs] @r}]-									  [<cons $z $zs> (helper {@xs z} zs {[ys xs] @r})]}))]}+									 {[<nil> {[{} xs]}]+									  [<cons $z $zs> {[ys xs] @(helper {@xs z} zs)}]}))]} 				 (helper {} tgt {}))]}]        [_ [Something]         {[$tgt {tgt}]}]@@ -121,11 +121,10 @@ (define $subcollections   (lambda [$xs]     (match xs (List Something)-      {[<nil> {{}}]-       [<cons $x $rs>-        (let {[$subs (subcollections rs)]}-          {@subs @(map (lambda [$sub] {x @sub})-                       subs)})]})))+	  {[<nil> {{}}]+	   [<cons $x $rs>+        (let {[$subs (subcollections rs)]} +		  {@subs @(map (lambda [$sub] {x @sub}) subs)})]})))  (define $size   (lambda [$xs]@@ -153,11 +152,8 @@     (match xs (List Something)       {[<snoc _ $ys> ys]}))) -(define $nth-  (lambda [$n $ls]-    (if (eq-n? n 1)-        (car ls)-        (nth (- n 1) (cdr ls)))))+(define $nth (lambda [$i $l]+  (match l (List Something) {[<cons $x $xs> (if (eq? i 0) x (nth (- i 1) xs))]})))  (define $reverse   (lambda [$xs]@@ -195,7 +191,6 @@           (if ((member? a) x ys)               ((subcollection? a) rest ys)               #f)]}))))-               (define $concat   (lambda [$xs]@@ -215,16 +210,26 @@         {[{} {[]}]          [_ {}]}]        [<cons ,$px _> [(Multiset a)]-        {[$tgt (if ((member? a) px tgt)-                   {((remove a) tgt px)}-                   {})]}]+        {[$tgt (letrec {[$helper (lambda [$xs $ys]+				   (match xs (List a)+				     {[<nil> {}]+				      [<cons ,px $zs> {{@ys @zs}}]+				      [<cons $z $zs> (helper zs {@ys z})]}))]}+		 (helper tgt {}))]}]        [<cons _ _> [a (Multiset a)]-        {[$tgt (map (lambda [$t] [t ((remove a) tgt t)])-                    ((unique a) tgt))]}]+        {[$tgt (letrec {[$helper (lambda [$xs $ys]+				   (match ys (List a)+				     {[<nil> {}]+				      [<cons $z $zs> (if ((member? a) z xs)+							 (helper {@xs z} zs)+							 {[z {@xs @zs}] @(helper {@xs z} zs)})]}))]}+		 (helper {} tgt))]}]        [<join ,$pxs _> [(Multiset a)]         {[$tgt (if ((subcollection? a) pxs tgt)                    {((remove-collection a) tgt pxs)}                    {})]}]+       [<join _ ,$pys> [(Multiset a)]+        {[$tgt (match-all tgt (Multiset a) [<join ,pys $xs> xs])]}]        [<join _ _> [(Multiset a) (Multiset a)]         {[$tgt (map (lambda [$ts] [ts ((remove-collection a) tgt ts)])                     (subcollections tgt))]}]@@ -243,10 +248,21 @@        [<nil> []         {[{} {[]}]          [_ {}]}]+       [<cons ,$px _> [(Set a)]+        {[$tgt (letrec {[$helper (lambda [$xs $ys]+				   (match xs (List a)+				     {[<nil> {}]+				      [<cons ,px $zs> {{@ys @zs} tgt}]+				      [<cons $z $zs> (helper zs {@ys z})]}))]}+		 (helper ((unique a) tgt) {}))]}]        [<cons _ _> [a (Set a)]         {[$tgt (let {[$tgt2 ((unique a) tgt)]}-                 {@(match-all tgt2 (Multiset a) [<cons $x $xs> [x xs]])-                  @(match-all tgt2 (Multiset a) [<cons $x $xs> [x {@xs x}]])})]}]+		 (letrec {[$helper (lambda [$xs $ys]+				     (match xs (List a)+				       {[<nil> {}]+					[<cons $z $zs> +					 {[z {@ys @zs}] [z tgt2] @(helper zs {@ys z})}]}))]}+		   (helper tgt2 {})))]}]        [<join _ _> [(Set a) (Set a)]         {[$tgt (let {[$tgt2 ((unique a) tgt)]}                  (concat (map (lambda [$xs $ys] (map (lambda [$sxs] [xs {@ys @sxs}])

@@ -17,7 +17,7 @@             <equal>             <greater>)))) -(define $Double+(define $Float   (type     {[,$d []       {[$tgt (if (eq-f? tgt d)

@@ -40,7 +40,7 @@                            l>                      <cons <node ,a_n <cons ,a_1 _> _>                            _>)>-         [@(loop $l $i (between 1 n) {a_i @l} {})]]))))+         (loop $l $i (between 1 n) {a_i @l} {})]))))  (define $hamilton-path   (lambda [$g]@@ -52,5 +52,5 @@                            l>                      <cons <node ,a_n _ _>                            <nil>>)>-         [@(loop $l $i (between 1 n) {a_i @l} {})]]))))+         (loop $l $i (between 1 n) {a_i @l} {})])))) 

@@ -10,4 +10,4 @@                                $a_i)                          l>                    <nil>)>-       [@(loop $l $i (between 1 n)  {a_i @l} {})]])))+       (loop $l $i (between 1 n)  {a_i @l} {})])))