egison 3.2.15 → 3.2.16
raw patch · 11 files changed
+313/−268 lines, 11 files
Files
- egison.cabal +3/−3
- elisp/egison-mode.el +15/−7
- hs-src/Interpreter/egisoni.hs +38/−45
- hs-src/Language/Egison/Core.hs +163/−150
- hs-src/Language/Egison/Desugar.hs +6/−0
- hs-src/Language/Egison/Parser.hs +23/−14
- hs-src/Language/Egison/Primitives.hs +17/−19
- hs-src/Language/Egison/Types.hs +9/−20
- hs-src/Language/Egison/Util.hs +39/−3
- lib/core/collection.egi +0/−5
- test/UnitTest.hs +0/−2
egison.cabal view
@@ -1,5 +1,5 @@ Name: egison-Version: 3.2.15+Version: 3.2.16 Synopsis: Programming language with non-linear pattern-matching against unfree data types Description: An interpreter for Egison, the programming langugage that realized non-linear pattern-matching against unfree data types.@@ -39,7 +39,7 @@ location: https://github.com/egisatoshi/egison3.git Library- Build-Depends: base >= 4.0 && < 5, array, random, containers, unordered-containers, haskeline, transformers, mtl, parsec >= 3.0, directory, ghc, ghc-paths, strict-io, bytestring, text+ Build-Depends: base >= 4.0 && < 5, array, random, containers, unordered-containers, haskeline, transformers, mtl, parsec >= 3.0, directory, ghc, ghc-paths, strict-io, bytestring, text, regex-posix Hs-Source-Dirs: hs-src Exposed-Modules: Language.Egison@@ -65,6 +65,6 @@ Executable egison Main-is: egisoni.hs- Build-depends: egison, base >= 4.0 && < 5, array, containers, unordered-containers, haskeline, transformers, mtl, parsec >= 3.0, directory, ghc, ghc-paths, filepath, regex-posix, strict-io, bytestring, unix+ Build-depends: egison, base >= 4.0 && < 5, array, containers, unordered-containers, haskeline, transformers, mtl, parsec >= 3.0, directory, ghc, ghc-paths, filepath, strict-io, bytestring, unix Other-modules: Paths_egison Hs-Source-Dirs: hs-src/Interpreter
elisp/egison-mode.el view
@@ -28,25 +28,27 @@ "\\<loop\\>" "\\<match\\>"+ "\\<match-lambda\\>" "\\<match-all\\>"- "\\<matcher\\>"+ "\\<match-all-lambda\\>"+ "\\<next-match\\>"+ "\\<next-match-lambda\\>"+ "\\<next-match-all\\>"+ "\\<next-match-all-lambda\\>"+ "\\<next-matcher\\>" "\\<algebraic-data-matcher\\>"- "\\<match-lambda\\>" "\\<pattern-function\\>" "\\<do\\>"+ "\\<io\\>" "\\<undefined\\>" "\\<something\\>" "\\\.\\\.\\\." "\\\,"- "\\\!"- "`"- "\\\~" "\\\#" "|"- "%" "\\\&" "@" "\\<_\\>"@@ -135,12 +137,18 @@ ((equal "array-ref" name) 2) ((equal "loop" name) 2) ((equal "match" name) 2)+ ((equal "match-lambda" name) 2) ((equal "match-all" name) 2)+ ((equal "match-all-lambda" name) 2)+ ((equal "next-match" name) 2)+ ((equal "next-match-lambda" name) 2)+ ((equal "next-match-all" name) 2)+ ((equal "next-match-all-lambda" name) 2) ((equal "matcher" name) 2) ((equal "algebraic-data-matcher" name) 2)- ((equal "match-lambda" name) 2) ((equal "pattern-function" name) 2) ((equal "do" name) 2)+ ((equal "io" name) 2) )) (defun egison-indent-line ()
hs-src/Interpreter/egisoni.hs view
@@ -4,21 +4,20 @@ import Control.Exception ( SomeException(..), AsyncException(..), catch, handle, throw)-import System.Posix.Signals import Control.Concurrent- import Control.Applicative ((<$>), (<*>)) import Control.Monad.Error import Data.List import Data.Sequence (Seq, ViewL(..), ViewR(..), (><)) import qualified Data.Sequence as Sq--import Data.Version import Data.ByteString.Lazy (ByteString) import Data.ByteString.Lazy.Char8 ()-import Text.Regex.Posix +import Data.Version++import System.Posix.Signals+ import System.Environment import System.Directory (getHomeDirectory) import System.FilePath ((</>))@@ -26,6 +25,7 @@ import System.Console.GetOpt import System.Exit (ExitCode (..), exitWith, exitFailure) import System.IO+ import Language.Egison import Language.Egison.Util @@ -112,6 +112,9 @@ putStrLn $ "Egison Version " ++ showVersion version ++ " (C) 2011-2014 Satoshi Egi" putStrLn $ "http://www.egison.org" putStrLn $ "Welcome to Egison Interpreter!"+ putStrLn $ "** Info **"+ putStrLn $ "We can use a \'Tab\' key to complete keywords on the interpreter."+ putStrLn $ "If we type a \'Tab\' key after after a closed parenthesis, the next closed parenthesis will be completed." showByebyeMessage :: IO () showByebyeMessage = do@@ -125,44 +128,34 @@ repl :: Env -> String -> IO () repl env prompt = do home <- getHomeDirectory- liftIO (runInputT (settings home) $ (loop env prompt ""))- where- settings :: MonadIO m => FilePath -> Settings m- settings home = do- setComplete completeEgison $ defaultSettings { historyFile = Just (home </> ".egison_history") }+ liftIO $ runInputT (settings home) $ loop env+ where+ settings :: MonadIO m => FilePath -> Settings m+ settings home = setComplete completeEgison $ defaultSettings { historyFile = Just (home </> ".egison_history") } - loop :: Env -> String -> String -> InputT IO ()- loop env prompt' rest = do- _ <- liftIO $ installHandler keyboardSignal (Catch (do {putStr "^C"; hFlush stdout})) Nothing- input <- getInputLine prompt'- tid <- liftIO $ myThreadId- _ <- liftIO $ installHandler keyboardSignal (Catch (throwTo tid UserInterruption)) Nothing- case input of- Nothing -> return () - Just "quit" -> return () - Just "" ->- case rest of- "" -> loop env prompt rest- _ -> loop env (take (length prompt) (repeat ' ')) rest- Just input' -> do- let newInput = rest ++ input'- result <- liftIO $ handle onAbort $ runEgisonTopExpr env newInput- case result of- Left err | show err =~ "unexpected end of input" -> do- loop env (take (length prompt) (repeat ' ')) $ newInput ++ "\n"- Left err | show err =~ "expecting (top-level|\"define\")" -> do- result <- liftIO $ handle onAbort $ runEgisonExpr env newInput- case result of- Left err | show err =~ "unexpected end of input" -> do- loop env (take (length prompt) (repeat ' ')) $ newInput ++ "\n"- Left err -> do- liftIO $ putStrLn $ show err- loop env prompt ""- Right val -> do- liftIO $ putStrLn $ show val- loop env prompt ""- Left err -> do- liftIO $ putStrLn $ show err- loop env prompt ""- Right env' ->- loop env' prompt ""+ loop :: Env -> InputT IO ()+ loop env = do+ _ <- liftIO $ installHandler keyboardSignal (Catch (do {putStr "^C"; hFlush stdout})) Nothing+ input <- getEgisonExpr prompt+ tid <- liftIO $ myThreadId+ _ <- liftIO $ installHandler keyboardSignal (Catch (throwTo tid UserInterruption)) Nothing+ case input of+ Nothing -> return ()+ Just (Left topExpr) -> do+ result <- liftIO $ handle onAbort $ evalEgisonTopExpr env topExpr+ case result of+ Left err -> do+ liftIO $ putStrLn $ show err+ loop env+ Right env' -> loop env'+ Just (Right expr) -> do+ result <- liftIO $ handle onAbort $ evalEgisonExpr env expr+ case result of+ Left err -> do+ liftIO $ putStrLn $ show err+ loop env+ Right val -> do+ liftIO $ putStrLn $ show val+ loop env++
hs-src/Language/Egison/Core.hs view
@@ -24,8 +24,12 @@ , recursiveBind -- * Pattern matching , patternMatch+ -- * Collection+ , isEmptyCollection+ , unconsCollection+ , unsnocCollection -- * Utiltiy functions- , fromStringWHNF+ , evalStringWHNF , fromStringValue ) where @@ -119,30 +123,31 @@ evalExpr _ (InductiveDataExpr name []) = return . Value $ InductiveData name [] evalExpr env (InductiveDataExpr name exprs) =- Intermediate . IInductiveData name <$> mapM (newThunk env) exprs + Intermediate . IInductiveData name <$> mapM (newObjectRef env) exprs evalExpr _ (TupleExpr []) = return . Value $ Tuple [] evalExpr env (TupleExpr [expr]) = evalExpr env expr-evalExpr env (TupleExpr exprs) = Intermediate . ITuple <$> mapM (newThunk env) exprs+evalExpr env (TupleExpr exprs) = Intermediate . ITuple <$> mapM (newObjectRef env) exprs evalExpr env (CollectionExpr inners) = if Sq.null inners then return . Value $ Collection Sq.empty else- Intermediate . ICollection <$> mapM fromInnerExpr inners+ Intermediate . ICollection <$> (mapM fromInnerExpr inners >>= liftIO . newIORef) where- fromInnerExpr (ElementExpr expr) = IElement <$> newThunk env expr- fromInnerExpr (SubCollectionExpr expr) = ISubCollection <$> newThunk env expr+ fromInnerExpr :: InnerExpr -> EgisonM Inner+ fromInnerExpr (ElementExpr expr) = IElement <$> newObjectRef env expr+ fromInnerExpr (SubCollectionExpr expr) = ISubCollection <$> newObjectRef env expr evalExpr env (ArrayExpr exprs) = do- ref' <- mapM (newThunk env) exprs+ ref' <- mapM (newObjectRef env) exprs return . Intermediate . IArray $ IntMap.fromList $ zip (enumFromTo 1 (length exprs)) ref' evalExpr env (HashExpr assocs) = do let (keyExprs, exprs) = unzip assocs keyWhnfs <- mapM (evalExpr env) keyExprs keys <- mapM makeHashKey keyWhnfs- refs <- mapM (newThunk env) exprs+ refs <- mapM (newObjectRef env) exprs case head keys of IntKey _ -> do let keys' = map (\key -> case key of@@ -158,11 +163,11 @@ case val of Integer i -> return (IntKey i) Collection _ -> do- str <- fromStringWHNF $ Value val+ str <- evalStringWHNF $ Value val return $ StrKey $ B.pack str _ -> throwError $ TypeMismatch "integer or string" $ Value val makeHashKey whnf = do- str <- fromStringWHNF whnf+ str <- evalStringWHNF whnf return $ StrKey $ B.pack str evalExpr env (IndexedExpr expr indices) = do@@ -193,12 +198,12 @@ Just ref -> evalRef ref >>= flip refArray indices Nothing -> return $ Value Undefined refArray (Value (StrHash hash)) (index:indices) = do- key <- fromStringWHNF $ Value index+ key <- evalStringWHNF $ Value index case HL.lookup (B.pack key) hash of Just val -> refArray (Value val) indices Nothing -> return $ Value Undefined refArray (Intermediate (IStrHash hash)) (index:indices) = do- key <- fromStringWHNF $ Value index+ key <- evalStringWHNF $ Value index case HL.lookup (B.pack key) hash of Just ref -> evalRef ref >>= flip refArray indices Nothing -> return $ Value Undefined@@ -216,7 +221,7 @@ where extractBindings :: BindingExpr -> EgisonM [Binding] extractBindings ([name], expr) =- makeBindings [name] . (:[]) <$> newThunk env expr+ makeBindings [name] . (:[]) <$> newObjectRef env expr extractBindings (names, expr) = makeBindings names <$> (evalExpr env expr >>= fromTuple) @@ -258,22 +263,22 @@ _ -> throwError $ TypeMismatch "io" io evalExpr env (MatchAllExpr target matcher (pattern, expr)) = do- target <- newThunk env target- - matcher <- evalExpr env matcher+ target <- newObjectRef env target+ matcher <- evalExpr env matcher >>= evalMatcherWHNF result <- patternMatch BFSMode env pattern target matcher mmap (flip evalExpr expr . extendEnv env) result >>= fromMList where fromMList :: MList EgisonM WHNFData -> EgisonM WHNFData fromMList MNil = return . Value $ Collection Sq.empty fromMList (MCons val m) = do- head <- IElement <$> newEvaluatedThunk val+ head <- IElement <$> newEvalutedObjectRef val tail <- ISubCollection <$> (liftIO . newIORef . Thunk $ m >>= fromMList)- return . Intermediate $ ICollection $ Sq.fromList [head, tail]+ seqRef <- liftIO . newIORef $ Sq.fromList [head, tail]+ return . Intermediate $ ICollection $ seqRef evalExpr env (MatchExpr target matcher clauses) = do- target <- newThunk env target- matcher <- evalExpr env matcher+ target <- newObjectRef env target+ matcher <- evalExpr env matcher >>= evalMatcherWHNF let tryMatchClause (pattern, expr) cont = do result <- patternMatch BFSMode env pattern target matcher case result of@@ -286,7 +291,7 @@ arg <- evalExpr env arg applyFunc func arg -evalExpr env (MatcherExpr info) = return $ Value $ Matcher (env, info)+evalExpr env (MatcherExpr info) = return $ Value $ UserMatcher env info evalExpr env (GenerateArrayExpr (name:[]) (TupleExpr (size:[])) expr) = generateArray env name size expr@@ -317,7 +322,7 @@ WHNF val -> return val Thunk thunk -> do val <- thunk- writeThunk ref val+ writeObjectRef ref val return val evalRefDeep :: ObjectRef -> EgisonM EgisonValue@@ -327,11 +332,11 @@ WHNF (Value val) -> return val WHNF val -> do val <- evalWHNF val- writeThunk ref $ Value val+ writeObjectRef ref $ Value val return val Thunk thunk -> do val <- thunk >>= evalWHNF- writeThunk ref $ Value val+ writeObjectRef ref $ Value val return val evalWHNF :: WHNFData -> EgisonM EgisonValue@@ -353,7 +358,7 @@ applyFunc :: WHNFData -> WHNFData -> EgisonM WHNFData applyFunc (Value (Func env [name] body)) arg = do- ref <- newEvaluatedThunk arg+ ref <- newEvalutedObjectRef arg evalExpr (extendEnv env $ makeBindings [name] [ref]) body applyFunc (Value (Func env names body)) arg = do refs <- fromTuple arg@@ -375,30 +380,33 @@ where genElem :: Int -> EgisonM (Int, ObjectRef) genElem i = do env <- bindEnv env name $ toInteger i- val <- evalExpr env expr >>= newEvaluatedThunk + val <- evalExpr env expr >>= newEvalutedObjectRef return (i, val) bindEnv :: Env -> String -> Integer -> EgisonM Env bindEnv env name i = do- ref <- newEvaluatedThunk (Value . Integer $ i)+ ref <- newEvalutedObjectRef (Value . Integer $ i) return $ extendEnv env [(name, ref)] -newThunk :: Env -> EgisonExpr -> EgisonM ObjectRef-newThunk env expr = liftIO . newIORef . Thunk $ evalExpr env expr+newThunk :: Env -> EgisonExpr -> Object+newThunk env expr = Thunk $ evalExpr env expr -writeThunk :: ObjectRef -> WHNFData -> EgisonM ()-writeThunk ref val = liftIO . writeIORef ref $ WHNF val+newObjectRef :: Env -> EgisonExpr -> EgisonM ObjectRef+newObjectRef env expr = liftIO . newIORef . Thunk $ evalExpr env expr -newEvaluatedThunk :: WHNFData -> EgisonM ObjectRef-newEvaluatedThunk = liftIO . newIORef . WHNF+writeObjectRef :: ObjectRef -> WHNFData -> EgisonM ()+writeObjectRef ref val = liftIO . writeIORef ref $ WHNF val +newEvalutedObjectRef :: WHNFData -> EgisonM ObjectRef+newEvalutedObjectRef = liftIO . newIORef . WHNF+ makeBindings :: [String] -> [ObjectRef] -> [Binding] makeBindings = zip recursiveBind :: Env -> [(String, EgisonExpr)] -> EgisonM Env recursiveBind env bindings = do let (names, exprs) = unzip bindings- refs <- replicateM (length bindings) $ newThunk nullEnv UndefinedExpr+ refs <- replicateM (length bindings) $ newObjectRef nullEnv UndefinedExpr let env' = extendEnv env $ makeBindings names refs zipWithM_ (\ref expr -> liftIO . writeIORef ref . Thunk $ evalExpr env' expr) refs exprs return env'@@ -407,7 +415,7 @@ -- Pattern Match -- -patternMatch :: PMMode -> Env -> EgisonPattern -> ObjectRef -> WHNFData ->+patternMatch :: PMMode -> Env -> EgisonPattern -> ObjectRef -> Matcher -> EgisonM (MList EgisonM [Binding]) patternMatch mode env pattern target matcher = processMState mode (MState env [] [] [MAtom pattern target matcher]) >>= (processMStates mode) . (:[])@@ -469,49 +477,46 @@ _ -> throwError $ TypeMismatch "pattern constructor" func LoopPat name (LoopRangeConstant start end) pat pat' -> do- startNum' <- evalExpr env' start- startNum <- fromWHNF startNum'- endNum' <- evalExpr env' end- endNum <- fromWHNF endNum'+ startNum <- evalExpr env' start >>= fromWHNF+ endNum <- evalExpr env' end >>= fromWHNF if startNum > endNum then do return $ msingleton $ MState env loops bindings (MAtom pat' target matcher : trees) else do- startNumRef <- newEvaluatedThunk $ Value $ Integer startNum+ startNumRef <- newEvalutedObjectRef $ Value $ Integer startNum let loops' = LoopContextConstant (name, startNumRef) endNum pat pat' : loops return $ msingleton $ MState env loops' bindings (MAtom pat target matcher : trees) LoopPat name (LoopRangeVariable start lastNumPat) pat pat' -> do- startNum' <- evalExpr env' start- startNum <- fromWHNF startNum'- startNumRef <- newEvaluatedThunk $ Value $ Integer startNum- lastNumRef <- newEvaluatedThunk $ Value $ Integer (startNum - 1)- return $ fromList [MState env loops bindings (MAtom lastNumPat lastNumRef (Value Something) : MAtom pat' target matcher : trees),+ startNum <- evalExpr env' start >>= fromWHNF+ startNumRef <- newEvalutedObjectRef $ Value $ Integer startNum+ lastNumRef <- newEvalutedObjectRef $ Value $ Integer (startNum - 1)+ return $ fromList [MState env loops bindings (MAtom lastNumPat lastNumRef Something : MAtom pat' target matcher : trees), MState env (LoopContextVariable (name, startNumRef) lastNumPat pat pat' : loops) bindings (MAtom pat target matcher : trees)] ContPat -> case loops of [] -> throwError $ strMsg "cannot use cont pattern except in loop pattern" LoopContextConstant (name, startNumRef) endNum pat pat' : loops -> do- startNum' <- evalRef startNumRef- startNum <- fromWHNF startNum'+ startNum <- evalRef startNumRef >>= fromWHNF let nextNum = startNum + 1 if nextNum > endNum then return $ msingleton $ MState env loops bindings (MAtom pat' target matcher : trees) else do- nextNumRef <- newEvaluatedThunk $ Value $ Integer nextNum+ nextNumRef <- newEvalutedObjectRef $ Value $ Integer nextNum let loops' = LoopContextConstant (name, nextNumRef) endNum pat pat' : loops return $ msingleton $ MState env loops' bindings (MAtom pat target matcher : trees) LoopContextVariable (name, startNumRef) lastNumPat pat pat' : loops -> do- startNum' <- evalRef startNumRef- startNum <- fromWHNF startNum'+ startNum <- evalRef startNumRef >>= fromWHNF let nextNum = startNum + 1- nextNumRef <- newEvaluatedThunk $ Value $ Integer nextNum+ nextNumRef <- newEvalutedObjectRef $ Value $ Integer nextNum let loops' = LoopContextVariable (name, nextNumRef) lastNumPat pat pat' : loops - return $ fromList [MState env loops bindings (MAtom lastNumPat startNumRef (Value Something) : MAtom pat' target matcher : trees),+ return $ fromList [MState env loops bindings (MAtom lastNumPat startNumRef Something : MAtom pat' target matcher : trees), MState env loops' bindings (MAtom pat target matcher : trees)] TuplePat patterns -> do- matchers <- fromTuple matcher >>= mapM evalRef targets <- evalRef target >>= fromTuple+ let matchers = fromTupleValue matcher+ if not (length patterns == length targets) then throwError $ ArgumentsNum (length patterns) (length targets) else return ()+ if not (length patterns == length matchers) then throwError $ ArgumentsNum (length patterns) (length matchers) else return () let trees' = zipWith3 MAtom patterns targets matchers ++ trees return $ msingleton $ MState env loops bindings trees' AndPat patterns ->@@ -529,7 +534,7 @@ else return MNil LetPat bindings' pattern -> let extractBindings ([name], expr) =- makeBindings [name] . (:[]) <$> newThunk env' expr+ makeBindings [name] . (:[]) <$> newObjectRef env' expr extractBindings (names, expr) = makeBindings names <$> (evalExpr env' expr >>= fromTuple) in@@ -537,14 +542,14 @@ >>= (\b -> return $ msingleton $ MState env loops (b ++ bindings) ((MAtom pattern target matcher):trees)) _ -> case matcher of- Value (Matcher matcher) -> do+ matcher@(UserMatcher _ _) -> do (patterns, targetss, matchers) <- inductiveMatch env' pattern target matcher mfor targetss $ \ref -> do targets <- evalRef ref >>= fromTuple let trees' = zipWith3 MAtom patterns targets matchers ++ trees return $ MState env loops bindings trees' - _ -> -- Value Something -> -- for tupple patterns+ Something -> case pattern of ValuePat valExpr -> do val <- evalExprDeep env' valExpr@@ -558,10 +563,10 @@ indices <- mapM (evalExpr env' >=> liftM fromInteger . fromWHNF) indices case lookup name bindings of Just ref -> do- obj <- evalRef ref >>= flip updateArray indices >>= newEvaluatedThunk+ obj <- evalRef ref >>= flip updateArray indices >>= newEvalutedObjectRef return $ msingleton $ MState env loops (subst name obj bindings) trees Nothing -> do- obj <- updateArray (Value $ Array IntMap.empty) indices >>= newEvaluatedThunk+ obj <- updateArray (Value $ Array IntMap.empty) indices >>= newEvalutedObjectRef return $ msingleton $ MState env loops ((name, obj):bindings) trees where updateArray :: WHNFData -> [Int] -> EgisonM WHNFData@@ -569,17 +574,17 @@ return . Intermediate . IArray $ IntMap.insert index target ary updateArray (Intermediate (IArray ary)) (index:indices) = do val <- maybe (return $ Value $ Array IntMap.empty) evalRef $ IntMap.lookup index ary- ref <- updateArray val indices >>= newEvaluatedThunk+ ref <- updateArray val indices >>= newEvalutedObjectRef return . Intermediate . IArray $ IntMap.insert index ref ary updateArray (Value (Array ary)) [index] = do keys <- return $ IntMap.keys ary- vals <- mapM (newEvaluatedThunk . Value) $ IntMap.elems ary+ vals <- mapM (newEvalutedObjectRef . Value) $ IntMap.elems ary return . Intermediate . IArray $ IntMap.insert index target (IntMap.fromList $ zip keys vals) updateArray (Value (Array ary)) (index:indices) = do let val = Value $ fromMaybe (Array IntMap.empty) $ IntMap.lookup index ary- ref <- updateArray val indices >>= newEvaluatedThunk+ ref <- updateArray val indices >>= newEvalutedObjectRef keys <- return $ IntMap.keys ary- vals <- mapM (newEvaluatedThunk . Value) $ IntMap.elems ary+ vals <- mapM (newEvalutedObjectRef . Value) $ IntMap.elems ary return . Intermediate . IArray $ IntMap.insert index ref (IntMap.fromList $ zip keys vals) updateArray _ _ = do throwError $ strMsg "expected array value"@@ -616,8 +621,8 @@ _ -> processMState' state >>= mmap (return . MState env loops bindings . (: trees) . MNode penv) inductiveMatch :: Env -> EgisonPattern -> ObjectRef -> Matcher ->- EgisonM ([EgisonPattern], MList EgisonM ObjectRef, [WHNFData])-inductiveMatch env pattern target (matcherEnv, clauses) = do+ EgisonM ([EgisonPattern], MList EgisonM ObjectRef, [Matcher])+inductiveMatch env pattern target (UserMatcher matcherEnv clauses) = do foldr tryPPMatchClause failPPPatternMatch clauses where tryPPMatchClause (pat, matchers, clauses) cont = do@@ -625,7 +630,7 @@ case result of Just (patterns, bindings) -> do targetss <- foldr tryPDMatchClause failPDPatternMatch clauses- matchers <- evalExpr matcherEnv matchers >>= fromTuple >>= mapM evalRef+ matchers <- evalExpr matcherEnv matchers >>= evalMatcherWHNF >>= (return . fromTupleValue) return (patterns, targetss, matchers) where tryPDMatchClause (pat, expr) cont = do@@ -644,7 +649,7 @@ primitivePatPatternMatch _ PPWildCard _ = return ([], []) primitivePatPatternMatch _ PPPatVar pattern = return ([pattern], []) primitivePatPatternMatch env (PPValuePat name) (ValuePat expr) = do- ref <- lift $ newThunk env expr+ ref <- lift $ newObjectRef env expr return ([], [(name, ref)]) primitivePatPatternMatch env (PPInductivePat name patterns) (InductivePat name' exprs) | name == name' =@@ -656,23 +661,26 @@ primitiveDataPatternMatch PDWildCard _ = return [] primitiveDataPatternMatch (PDPatVar name) ref = return [(name, ref)] primitiveDataPatternMatch (PDInductivePat name patterns) ref = do- val <- lift $ evalRef ref- case val of+ whnf <- lift $ evalRef ref+ case whnf of Intermediate (IInductiveData name' refs) | name == name' -> concat <$> zipWithM primitiveDataPatternMatch patterns refs Value (InductiveData name' vals) | name == name' -> do- refs <- lift $ mapM (newEvaluatedThunk . Value) vals+ refs <- lift $ mapM (newEvalutedObjectRef . Value) vals concat <$> zipWithM primitiveDataPatternMatch patterns refs _ -> matchFail primitiveDataPatternMatch PDEmptyPat ref = do- isEmpty <- lift $ isEmptyCollection ref+ whnf <- lift $ evalRef ref+ isEmpty <- lift $ isEmptyCollection whnf if isEmpty then return [] else matchFail primitiveDataPatternMatch (PDConsPat pattern pattern') ref = do- (head, tail) <- unconsCollection ref+ whnf <- lift $ evalRef ref+ (head, tail) <- unconsCollection whnf (++) <$> primitiveDataPatternMatch pattern head <*> primitiveDataPatternMatch pattern' tail primitiveDataPatternMatch (PDSnocPat pattern pattern') ref = do- (init, last) <- unsnocCollection ref+ whnf <- lift $ evalRef ref+ (init, last) <- unsnocCollection whnf (++) <$> primitiveDataPatternMatch pattern init <*> primitiveDataPatternMatch pattern' last primitiveDataPatternMatch (PDConstantPat expr) ref = do@@ -682,107 +690,112 @@ expandCollection :: WHNFData -> EgisonM (Seq Inner) expandCollection (Value (Collection vals)) =- mapM (liftM IElement . newEvaluatedThunk . Value) vals-expandCollection (Intermediate (ICollection inners)) = return inners+ mapM (liftM IElement . newEvalutedObjectRef . Value) vals+expandCollection (Intermediate (ICollection innersRef)) = liftIO $ readIORef innersRef expandCollection val = throwError $ TypeMismatch "collection" val -isEmptyCollection :: ObjectRef -> EgisonM Bool-isEmptyCollection ref = evalRef ref >>= isEmptyCollection'- where- isEmptyCollection' :: WHNFData -> EgisonM Bool- isEmptyCollection' (Value (Collection col)) = return $ Sq.null col- isEmptyCollection' (Intermediate (ICollection ic)) =- case Sq.viewl ic of- EmptyL -> return True- (ISubCollection ref') :< inners -> do- inners' <- evalRef ref' >>= expandCollection- let coll = Intermediate (ICollection (inners' >< inners))- writeThunk ref coll- isEmptyCollection' coll- _ -> return False- isEmptyCollection' _ = return False+isEmptyCollection :: WHNFData -> EgisonM Bool+isEmptyCollection (Value (Collection col)) = return $ Sq.null col+isEmptyCollection coll@(Intermediate (ICollection innersRef)) = do+ inners <- liftIO $ readIORef innersRef+ case Sq.viewl inners of+ EmptyL -> return True+ (ISubCollection ref') :< tInners -> do+ hInners <- evalRef ref' >>= expandCollection+ liftIO $ writeIORef innersRef (hInners >< tInners)+ isEmptyCollection coll+ _ -> return False+isEmptyCollection _ = return False -unconsCollection :: ObjectRef -> MatchM (ObjectRef, ObjectRef)-unconsCollection ref = lift (evalRef ref) >>= unconsCollection'- where- unconsCollection' :: WHNFData -> MatchM (ObjectRef, ObjectRef)- unconsCollection' (Value (Collection col)) =- case Sq.viewl col of- EmptyL -> matchFail- val :< vals ->- lift $ (,) <$> newEvaluatedThunk (Value val)- <*> newEvaluatedThunk (Value $ Collection vals)- unconsCollection' (Intermediate (ICollection ic)) =- case Sq.viewl ic of- EmptyL -> matchFail- (IElement ref') :< inners ->- lift $ (ref', ) <$> newEvaluatedThunk (Intermediate $ ICollection inners)- (ISubCollection ref') :< inners -> do- inners' <- lift $ evalRef ref' >>= expandCollection- let coll = Intermediate (ICollection (inners' >< inners))- lift $ writeThunk ref coll- unconsCollection' coll- unconsCollection' _ = matchFail+unconsCollection :: WHNFData -> MatchM (ObjectRef, ObjectRef)+unconsCollection (Value (Collection col)) =+ case Sq.viewl col of+ EmptyL -> matchFail+ val :< vals ->+ lift $ (,) <$> newEvalutedObjectRef (Value val)+ <*> newEvalutedObjectRef (Value $ Collection vals)+unconsCollection coll@(Intermediate (ICollection innersRef)) = do+ inners <- liftIO $ readIORef innersRef+ case Sq.viewl inners of+ EmptyL -> matchFail+ (IElement ref') :< tInners -> do+ tInnersRef <- liftIO $ newIORef tInners+ lift $ (ref', ) <$> newEvalutedObjectRef (Intermediate $ ICollection tInnersRef)+ (ISubCollection ref') :< tInners -> do+ hInners <- lift $ evalRef ref' >>= expandCollection+ liftIO $ writeIORef innersRef (hInners >< tInners)+ unconsCollection coll+unconsCollection _ = matchFail -unsnocCollection :: ObjectRef -> MatchM (ObjectRef, ObjectRef)-unsnocCollection ref = lift (evalRef ref) >>= unsnocCollection'- where- unsnocCollection' :: WHNFData -> MatchM (ObjectRef, ObjectRef)- unsnocCollection' (Value (Collection col)) =- case Sq.viewr col of- EmptyR -> matchFail- vals :> val ->- lift $ (,) <$> newEvaluatedThunk (Value $ Collection vals)- <*> newEvaluatedThunk (Value val)- unsnocCollection' (Intermediate (ICollection ic)) =- case Sq.viewr ic of- EmptyR -> matchFail- inners :> (IElement ref') ->- lift $ (, ref') <$> newEvaluatedThunk (Intermediate $ ICollection inners)- inners :> (ISubCollection ref') -> do- inners' <- lift $ evalRef ref' >>= expandCollection- let coll = Intermediate (ICollection (inners >< inners'))- lift $ writeThunk ref coll- unsnocCollection' coll- unsnocCollection' _ = matchFail+unsnocCollection :: WHNFData -> MatchM (ObjectRef, ObjectRef)+unsnocCollection (Value (Collection col)) =+ case Sq.viewr col of+ EmptyR -> matchFail+ vals :> val ->+ lift $ (,) <$> newEvalutedObjectRef (Value $ Collection vals)+ <*> newEvalutedObjectRef (Value val)+unsnocCollection coll@(Intermediate (ICollection innersRef)) = do+ inners <- liftIO $ readIORef innersRef+ case Sq.viewr inners of+ EmptyR -> matchFail+ hInners :> (IElement ref') -> do+ hInnersRef <- liftIO $ newIORef hInners+ lift $ (, ref') <$> newEvalutedObjectRef (Intermediate $ ICollection hInnersRef)+ hInners :> (ISubCollection ref') -> do+ tInners <- lift $ evalRef ref' >>= expandCollection+ liftIO $ writeIORef innersRef (hInners >< tInners)+ unsnocCollection coll+unsnocCollection _ = matchFail -- -- Util -- fromTuple :: WHNFData -> EgisonM [ObjectRef] fromTuple (Intermediate (ITuple refs)) = return refs-fromTuple (Value (Tuple vals)) = mapM (newEvaluatedThunk . Value) vals-fromTuple val = return <$> newEvaluatedThunk val+fromTuple (Value (Tuple vals)) = mapM (newEvalutedObjectRef . Value) vals+fromTuple val = return <$> newEvalutedObjectRef val +fromTupleValue :: EgisonValue -> [EgisonValue]+fromTupleValue (Tuple vals) = vals+fromTupleValue val = [val]+ fromCollection :: WHNFData -> EgisonM (MList EgisonM ObjectRef) fromCollection (Value (Collection vals)) = if Sq.null vals then return MNil- else fromSeq <$> mapM (newEvaluatedThunk . Value) vals-fromCollection coll@(Intermediate (ICollection _)) =- newEvaluatedThunk coll >>= fromCollection'- where- fromCollection' ref = do- isEmpty <- isEmptyCollection ref- if isEmpty- then return MNil- else do- (head, tail) <- fromJust <$> runMaybeT (unconsCollection ref)- return $ MCons head (fromCollection' tail)-fromCollection val = throwError $ TypeMismatch "collection" val+ else fromSeq <$> mapM (newEvalutedObjectRef . Value) vals+fromCollection whnf@(Intermediate (ICollection _)) = do+ isEmpty <- isEmptyCollection whnf+ if isEmpty+ then return MNil+ else do+ (head, tail) <- fromJust <$> runMaybeT (unconsCollection whnf)+ tail' <- evalRef tail+ return $ MCons head (fromCollection tail')+fromCollection whnf = throwError $ TypeMismatch "collection" whnf -- -- String ---fromStringWHNF :: WHNFData -> EgisonM String-fromStringWHNF (Value (Collection seq)) = do+evalStringWHNF :: WHNFData -> EgisonM String+evalStringWHNF (Value (Collection seq)) = do let ls = toList seq mapM (\val -> case val of Char c -> return c _ -> throwError $ TypeMismatch "char" (Value val)) ls-fromStringWHNF (Value (Tuple [val])) = fromStringWHNF (Value val)-fromStringWHNF whnf@(Intermediate (ICollection _)) = evalWHNF whnf >>= fromStringWHNF . Value-fromStringWHNF whnf = throwError $ TypeMismatch "string" whnf+evalStringWHNF (Value (Tuple [val])) = evalStringWHNF (Value val)+evalStringWHNF whnf@(Intermediate (ICollection _)) = evalWHNF whnf >>= evalStringWHNF . Value+evalStringWHNF whnf = throwError $ TypeMismatch "string" whnf++evalMatcherWHNF :: WHNFData -> EgisonM Matcher+evalMatcherWHNF (Value matcher@Something) = return matcher+evalMatcherWHNF (Value matcher@(UserMatcher _ _)) = return matcher+evalMatcherWHNF (Value (Tuple ms)) = Tuple <$> mapM (evalMatcherWHNF . Value) ms+evalMatcherWHNF (Intermediate (ITuple refs)) = do+ whnfs <- mapM evalRef refs+ ms <- mapM evalMatcherWHNF whnfs+ return $ Tuple ms+evalMatcherWHNF whnf = throwError $ TypeMismatch "matcher" whnf fromStringValue :: EgisonValue -> EgisonM String fromStringValue (Collection seq) = do
hs-src/Language/Egison/Desugar.hs view
@@ -116,6 +116,12 @@ matchingFailure :: EgisonExpr matchingFailure = CollectionExpr Sq.empty +desugar (MatchAllLambdaExpr matcher clause) = do+ name <- fresh+ matcher' <- desugar matcher+ clause' <- desugarMatchClause clause+ return $ LambdaExpr [name] (MatchAllExpr (VarExpr name) matcher' clause')+ desugar (MatchLambdaExpr matcher clauses) = do name <- fresh matcher' <- desugar matcher
hs-src/Language/Egison/Parser.hs view
@@ -15,6 +15,10 @@ , readTopExpr , readExprs , readExpr+ , parseTopExprs+ , parseTopExpr+ , parseExprs+ , parseExpr -- * Parse a file , loadLibraryFile , loadFile@@ -58,6 +62,18 @@ readExpr :: String -> EgisonM EgisonExpr readExpr = liftEgisonM . runDesugarM . either throwError desugar . parseExpr +parseTopExprs :: String -> Either EgisonError [EgisonTopExpr]+parseTopExprs = doParse $ whiteSpace >> endBy topExpr whiteSpace++parseTopExpr :: String -> Either EgisonError EgisonTopExpr+parseTopExpr = doParse $ whiteSpace >> topExpr++parseExprs :: String -> Either EgisonError [EgisonExpr]+parseExprs = doParse $ whiteSpace >> endBy expr whiteSpace++parseExpr :: String -> Either EgisonError EgisonExpr+parseExpr = doParse $ whiteSpace >> expr+ -- |Load a libary file loadLibraryFile :: FilePath -> EgisonM [EgisonTopExpr] loadLibraryFile file = liftIO (getDataFileName file) >>= loadFile@@ -88,18 +104,6 @@ fromParsecError :: ParseError -> EgisonError fromParsecError = Parser . show -parseTopExprs :: String -> Either EgisonError [EgisonTopExpr]-parseTopExprs = doParse $ whiteSpace >> endBy topExpr whiteSpace--parseTopExpr :: String -> Either EgisonError EgisonTopExpr-parseTopExpr = doParse $ whiteSpace >> topExpr--parseExprs :: String -> Either EgisonError [EgisonExpr]-parseExprs = doParse $ whiteSpace >> endBy expr whiteSpace--parseExpr :: String -> Either EgisonError EgisonExpr-parseExpr = doParse $ whiteSpace >> expr- -- -- Expressions --@@ -150,8 +154,9 @@ <|> ioExpr <|> matchAllExpr <|> matchExpr- <|> matcherExpr+ <|> matchAllLambdaExpr <|> matchLambdaExpr+ <|> matcherExpr <|> applyExpr <|> algebraicDataMatcherExpr <|> generateArrayExpr@@ -195,6 +200,9 @@ matchExpr :: Parser EgisonExpr matchExpr = keywordMatch >> MatchExpr <$> expr <*> expr <*> matchClauses +matchAllLambdaExpr :: Parser EgisonExpr+matchAllLambdaExpr = keywordMatchAllLambda >> MatchAllLambdaExpr <$> expr <*> matchClause+ matchLambdaExpr :: Parser EgisonExpr matchLambdaExpr = keywordMatchLambda >> MatchLambdaExpr <$> expr <*> matchClauses @@ -477,8 +485,9 @@ , "let" , "loop" , "match-all"- , "match-lambda" , "match"+ , "match-all-lambda"+ , "match-lambda" , "matcher" , "do" , "io"
hs-src/Language/Egison/Primitives.hs view
@@ -13,6 +13,7 @@ import Control.Arrow import Control.Applicative import Control.Monad.Error+import Control.Monad.Trans.Maybe import Data.IORef import qualified Data.Array as A@@ -28,6 +29,7 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BC import qualified Data.Text as T+import Data.Maybe import Control.Monad @@ -157,13 +159,9 @@ , ("read", read') , ("show", show') -{-- , ("empty?", isEmpty')- , ("car", car')- , ("cdr", cdr')- , ("rac", rac')- , ("rdc", rdc')---}+ , ("uncons", uncons')+ , ("unsnoc", unsnoc') , ("assert", assert) , ("assert-equal", assertEqual)@@ -395,22 +393,22 @@ show' :: PrimitiveFunc show'= oneArg $ \val -> return $ toEgison $ show val -{-- isEmpty' :: PrimitiveFunc-isEmpty' = undefined--car' :: PrimitiveFunc-car' = undefined--cdr' :: PrimitiveFunc-cdr' = undefined+isEmpty' whnf = do+ b <- isEmptyCollection whnf+ if b+ then return $ Value $ Bool True+ else return $ Value $ Bool False -rac' :: PrimitiveFunc-rac' = undefined+uncons' :: PrimitiveFunc+uncons' whnf = do+ (carObjRef, cdrObjRef) <- fromJust <$> runMaybeT (unconsCollection whnf)+ return $ Intermediate $ ITuple [carObjRef, cdrObjRef] -rdc' :: PrimitiveFunc-rdc' = undefined---}+unsnoc' :: PrimitiveFunc+unsnoc' whnf = do+ (racObjRef, rdcObjRef) <- fromJust <$> runMaybeT (unsnocCollection whnf)+ return $ Intermediate $ ITuple [racObjRef, rdcObjRef] assert :: PrimitiveFunc assert = twoArgs $ \label test -> do
hs-src/Language/Egison/Types.hs view
@@ -27,7 +27,6 @@ , Matcher (..) , PrimitiveFunc (..) , Egison (..)- , fromMatcherValue -- * Internal data , Object (..) , ObjectRef (..)@@ -145,6 +144,7 @@ | MatchExpr EgisonExpr EgisonExpr [MatchClause] | MatchAllExpr EgisonExpr EgisonExpr MatchClause | MatchLambdaExpr EgisonExpr [MatchClause]+ | MatchAllLambdaExpr EgisonExpr MatchClause | MatcherExpr MatcherInfo @@ -158,7 +158,6 @@ | ArraySizeExpr EgisonExpr | ArrayRefExpr EgisonExpr EgisonExpr - | ValueExpr EgisonValue | SomethingExpr | UndefinedExpr deriving (Show)@@ -229,7 +228,7 @@ | Array (IntMap EgisonValue) | IntHash (HashMap Integer EgisonValue) | StrHash (HashMap ByteString EgisonValue)- | Matcher Matcher+ | UserMatcher Env MatcherInfo | Func Env [String] EgisonExpr | PatternFunc Env [String] EgisonPattern | PrimitiveFunc PrimitiveFunc@@ -239,7 +238,8 @@ | Undefined | EOF -type Matcher = (Env, MatcherInfo)+type Matcher = EgisonValue+ type PrimitiveFunc = WHNFData -> EgisonM WHNFData instance Show EgisonValue where@@ -264,7 +264,7 @@ show (Array vals) = "[|" ++ unwords (map show $ IntMap.elems vals) ++ "|]" show (IntHash hash) = "{|" ++ unwords (map (\(key, val) -> "[" ++ show key ++ " " ++ show val ++ "]") $ HashMap.toList hash) ++ "|}" show (StrHash hash) = "{|" ++ unwords (map (\(key, val) -> "[\"" ++ B.unpack key ++ "\" " ++ show val ++ "]") $ HashMap.toList hash) ++ "|}"- show (Matcher _) = "#<matcher>"+ show (UserMatcher _ _) = "#<matcher>" show (Func _ names _) = "(lambda [" ++ unwords names ++ "] ...)" show (PatternFunc _ _ _) = "#<pattern-function>" show (PrimitiveFunc _) = "#<primitive-function>"@@ -375,11 +375,6 @@ fromPortValue (Port handle) = return handle fromPortValue val = throwError $ TypeMismatch "port" (Value val) --- TODO : write instance declaration for Matcher-fromMatcherValue :: EgisonValue -> Either EgisonError Matcher-fromMatcherValue (Matcher matcher) = return matcher-fromMatcherValue val = throwError $ TypeMismatch "matcher" (Value val)- -- -- Internal Data --@@ -388,6 +383,7 @@ Thunk (EgisonM WHNFData) | WHNF WHNFData +-- |For memoization type ObjectRef = IORef Object data WHNFData =@@ -397,7 +393,7 @@ data Intermediate = IInductiveData String [ObjectRef] | ITuple [ObjectRef]- | ICollection (Seq Inner)+ | ICollection (IORef (Seq Inner)) | IArray (IntMap ObjectRef) | IIntHash (HashMap Integer ObjectRef) | IStrHash (HashMap ByteString ObjectRef)@@ -439,9 +435,6 @@ instance EgisonWHNF Handle where fromWHNF = liftError . fromPortWHNF -instance EgisonWHNF Matcher where- fromWHNF = liftError . fromMatcherWHNF- fromCharWHNF :: WHNFData -> Either EgisonError Char fromCharWHNF (Value (Char c)) = return c fromCharWHNF whnf = throwError $ TypeMismatch "char" whnf@@ -466,10 +459,6 @@ fromPortWHNF (Value (Port handle)) = return handle fromPortWHNF whnf = throwError $ TypeMismatch "port" whnf -fromMatcherWHNF :: WHNFData -> Either EgisonError Matcher-fromMatcherWHNF (Value (Matcher matcher)) = return matcher-fromMatcherWHNF whnf = throwError $ TypeMismatch "matcher" whnf- -- -- Environment --@@ -497,7 +486,7 @@ data MatchingState = MState Env [LoopContext] [Binding] [MatchingTree] data MatchingTree =- MAtom EgisonPattern ObjectRef WHNFData+ MAtom EgisonPattern ObjectRef Matcher | MNode [PatternBinding] MatchingState type PatternBinding = (Var, EgisonPattern)@@ -629,7 +618,7 @@ matchFail :: MatchM a matchFail = MaybeT $ return Nothing -data MList m a = MNil | MCons a (m (MList m a)) +data MList m a = MNil | MCons a (m (MList m a)) fromList :: Monad m => [a] -> MList m a fromList = foldr f MNil
hs-src/Language/Egison/Util.hs view
@@ -6,11 +6,47 @@ This module provides utility functions. -} -module Language.Egison.Util (completeEgison) where+module Language.Egison.Util (getEgisonExpr, completeEgison) where import Data.List+import Text.Regex.Posix import System.Console.Haskeline hiding (handle, catch, throwTo)+import Control.Monad.Error (liftIO) +import Language.Egison.Types+import Language.Egison.Parser+++-- |Get Egison expression from the prompt. We can handle multiline input.+getEgisonExpr :: String -> InputT IO (Maybe (Either EgisonTopExpr EgisonExpr))+getEgisonExpr prompt = getEgisonExpr' ""+ where+ getEgisonExpr' :: String -> InputT IO (Maybe (Either EgisonTopExpr EgisonExpr))+ getEgisonExpr' prev = do+ mLine <- case prev of+ "" -> getInputLine prompt+ _ -> getInputLine $ take (length prompt ) (repeat ' ')+ case mLine of+ Nothing -> return Nothing+ Just line -> do+ let input = prev ++ line+ case parseTopExpr input of+ Left err | show err =~ "unexpected end of input" -> do+ getEgisonExpr' $ input ++ "\n"+ Left err | show err =~ "expecting (top-level|\"define\")" ->+ case parseExpr input of+ Left err | show err =~ "unexpected end of input" -> do+ getEgisonExpr' $ input ++ "\n"+ Left err -> do+ liftIO $ putStrLn $ show err+ getEgisonExpr prompt+ Right expr -> return $ Just $ Right expr+ Left err -> do+ liftIO $ putStrLn $ show err+ getEgisonExpr prompt+ Right topExpr -> return $ Just $ Left topExpr++ -- |Complete Egison keywords completeEgison :: Monad m => CompletionFunc m completeEgison arg@((')':_), _) = completeParen arg@@ -37,9 +73,9 @@ completeEgisonKeyword :: Monad m => String -> m [Completion] completeEgisonKeyword str = return $ map (\kwd -> Completion kwd kwd False) $ filter (isPrefixOf str) egisonKeywords -egisonPrimitivesAfterOpenParen = map ((:) '(') $ ["+", "-", "*", "/", "numerator", "denominator", "modulo", "quotient", "remainder", "neg", "abs", "eq?", "lt?", "lte?", "gt?", "gte?", "round", "floor", "ceiling", "truncate", "sqrt", "exp", "log", "sin", "cos", "tan", "asin", "acos", "atan", "sinh", "cosh", "tanh", "asinh", "acosh", "atanh", "itof", "rtof", "stoi", "read", "show", "assert", "assert-equal"]+egisonPrimitivesAfterOpenParen = map ((:) '(') $ ["+", "-", "*", "/", "numerator", "denominator", "modulo", "quotient", "remainder", "neg", "abs", "eq?", "lt?", "lte?", "gt?", "gte?", "round", "floor", "ceiling", "truncate", "sqrt", "exp", "log", "sin", "cos", "tan", "asin", "acos", "atan", "sinh", "cosh", "tanh", "asinh", "acosh", "atanh", "itof", "rtof", "stoi", "read", "show", "empty?", "uncons", "unsnoc", "assert", "assert-equal"] egisonKeywordsAfterOpenParen = map ((:) '(') $ ["define", "let", "letrec", "lambda", "match", "match-all", "match-lambda", "matcher", "algebraic-data-matcher", "pattern-function", "if", "loop", "io", "do"]- ++ ["id", "or", "and", "not", "char", "eq?/m", "compose", "compose3", "list", "map", "between", "repeat1", "repeat", "filter", "separate", "concat", "foldr", "foldl", "map2", "zip", "empty?", "member?", "member?/m", "include?", "include?/m", "any", "all", "length", "count", "count/m", "car", "cdr", "rac", "rdc", "nth", "take", "drop", "while", "reverse", "multiset", "add", "add/m", "delete-first", "delete-first/m", "delete", "delete/m", "difference", "difference/m", "union", "union/m", "intersect", "intersect/m", "set", "unique", "unique/m", "print", "print-to-port", "each", "pure-rand", "fib", "fact", "divisor?", "gcd", "primes", "find-factor", "prime-factorization", "p-f", "min", "max", "min-and-max", "power", "mod", "qsort", "intersperse", "intercalate", "split", "split/m"]+ ++ ["id", "or", "and", "not", "char", "eq?/m", "compose", "compose3", "list", "map", "between", "repeat1", "repeat", "filter", "separate", "concat", "foldr", "foldl", "map2", "zip", "member?", "member?/m", "include?", "include?/m", "any", "all", "length", "count", "count/m", "car", "cdr", "rac", "rdc", "nth", "take", "drop", "while", "reverse", "multiset", "add", "add/m", "delete-first", "delete-first/m", "delete", "delete/m", "difference", "difference/m", "union", "union/m", "intersect", "intersect/m", "set", "unique", "unique/m", "print", "print-to-port", "each", "pure-rand", "fib", "fact", "divisor?", "gcd", "primes", "find-factor", "prime-factorization", "p-f", "min", "max", "min-and-max", "power", "mod", "qsort", "intersperse", "intercalate", "split", "split/m"] egisonKeywordsAfterOpenCons = map ((:) '<') ["nil", "cons", "join", "snoc", "nioj"] egisonKeywordsInNeutral = ["something"] ++ ["bool", "string", "integer", "nats", "primes"]
lib/core/collection.egi view
@@ -124,11 +124,6 @@ ;; ;; Simple predicate ;;-(define $empty?- (match-lambda (list something)- {[<nil> #t]- [<cons _ _> #f]}))- (define $member? (lambda [$x $ys] (match ys (list something)
test/UnitTest.hs view
@@ -35,5 +35,3 @@ collectDefsAndTests (Test expr) (bindings, tests) = (bindings, expr : tests) collectDefsAndTests _ r = r- -