egison 3.5.7 → 3.5.8

raw patch · 10 files changed

+70/−31 lines, 10 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• egison.cabal +1/−1
• elisp/egison-mode.el +1/−0
• hs-src/Language/Egison/Core.hs +21/−7
• hs-src/Language/Egison/Desugar.hs +7/−2
• hs-src/Language/Egison/Parser.hs +8/−2
• hs-src/Language/Egison/Types.hs +1/−1
• lib/core/base.egi +5/−5
• lib/core/collection.egi +0/−8
• lib/core/number.egi +5/−5
• lib/core/order.egi +21/−0

@@ -1,5 +1,5 @@ Name:                egison-Version:             3.5.7+Version:             3.5.8 Synopsis:            Programming language with non-linear pattern-matching against non-free data Description:   An interpreter for Egison, a **pattern-matching-oriented**, purely functional programming language.

@@ -170,6 +170,7 @@         ((equal "execute" name) 2)         ((equal "lambda" name) 2)         ((equal "memoized-lambda" name) 2)+        ((equal "memoize" name) 2)         ((equal "letrec" name) 2)         ((equal "let" name) 2)         ((equal "let*" name) 2)

@@ -308,6 +308,21 @@           return whnf     _ -> applyFunc func arg +evalExpr env (MemoizeExpr memoizeFrame expr) = do+  mapM (\(x, y, z) -> do x' <- evalExprDeep env x+                         case x' of+                           (MemoizedFunc ref hashRef env' names body) -> do+                             indices <- evalExprDeep env y+                             indices' <- mapM fromEgison $ fromTupleValue indices+                             hash <- liftIO $ readIORef hashRef+                             ret <- evalExprDeep env z+                             retRef <- newEvalutedObjectRef (Value ret)+                             liftIO $ writeIORef hashRef (HL.insert indices' retRef hash)+                             writeObjectRef ref (Value (MemoizedFunc ref hashRef env' names body))+                           _ -> throwError $ TypeMismatch "memoized-function" (Value x'))+       memoizeFrame+  evalExpr env expr+ evalExpr env (MatcherBFSExpr info) = return $ Value $ UserMatcher env BFSMode info evalExpr env (MatcherDFSExpr info) = return $ Value $ UserMatcher env DFSMode info @@ -478,9 +493,6 @@                  MemoizedLambdaExpr names body -> do                    hashRef <- liftIO $ newIORef HL.empty                    liftIO . writeIORef ref . WHNF . Value $ MemoizedFunc ref hashRef env' names body-                 MemoizeExpr fnExpr -> do-                   hashRef <- liftIO $ newIORef HL.empty-                   liftIO . writeIORef ref . WHNF . Value $ MemoizedFunc ref hashRef env' ["arg"] (ApplyExpr fnExpr (VarExpr "arg"))                  _ -> liftIO . writeIORef ref . Thunk $ evalExpr env' expr)             refs exprs   return env'@@ -648,10 +660,12 @@             else do               (carEndsRef, cdrEndsRef) <- fromJust <$> runMaybeT (unconsCollection ends)               carEndsNum <- evalRef carEndsRef >>= fromWHNF-              if startNum == carEndsNum-                then return $ fromList [MState env loops' bindings ((MAtom endPat startNumRef Something):(MAtom pat' target matcher):trees),-                                        MState env ((LoopPatContext (name, nextNumRef) cdrEndsRef endPat pat pat'):loops') bindings ((MAtom pat target matcher):trees)]-                else return $ fromList [MState env ((LoopPatContext (name, nextNumRef) endsRef endPat pat pat'):loops') bindings ((MAtom pat target matcher):trees)]+              if startNum > carEndsNum+                then return MNil+                else if startNum == carEndsNum+                       then return $ fromList [MState env loops' bindings ((MAtom endPat startNumRef Something):(MAtom pat' target matcher):trees),+                                               MState env ((LoopPatContext (name, nextNumRef) cdrEndsRef endPat pat pat'):loops') bindings ((MAtom pat target matcher):trees)]+                       else return $ fromList [MState env ((LoopPatContext (name, nextNumRef) endsRef endPat pat pat'):loops') bindings ((MAtom pat target matcher):trees)]     AndPat patterns ->       let trees' = map (\pat -> MAtom pat target matcher) patterns ++ trees       in return $ msingleton $ MState env loops bindings trees'

@@ -172,9 +172,14 @@   expr' <- desugar expr   return $ MemoizedLambdaExpr names expr' -desugar (MemoizeExpr expr) = do+desugar (MemoizeExpr memoizeBindings expr) = do+  memoizeBindings' <- mapM (\(x,y,z) -> do x' <- desugar x+                                           y' <- desugar y+                                           z' <- desugar z+                                           return (x',y',z'))+                           memoizeBindings   expr' <- desugar expr-  return $ MemoizeExpr expr'+  return $ MemoizeExpr memoizeBindings' expr'  desugar (PatternFunctionExpr names pattern) = do   pattern' <- desugarPattern pattern

@@ -315,8 +315,14 @@ memoizedLambdaExpr = keywordMemoizedLambda >> MemoizedLambdaExpr <$> varNames <*> expr  memoizeExpr :: Parser EgisonExpr-memoizeExpr = keywordMemoize >> MemoizeExpr <$> expr+memoizeExpr = keywordMemoize >> MemoizeExpr <$> memoizeFrame <*> expr +memoizeFrame :: Parser [(EgisonExpr, EgisonExpr, EgisonExpr)]+memoizeFrame = braces $ sepEndBy memoizeBinding whiteSpace++memoizeBinding :: Parser (EgisonExpr, EgisonExpr, EgisonExpr)+memoizeBinding = brackets $ (,,) <$> expr <*> expr <*> expr+ patternFunctionExpr :: Parser EgisonExpr patternFunctionExpr = keywordPatternFunction >> PatternFunctionExpr <$> varNames <*> pattern @@ -646,7 +652,7 @@ keywordApply                = reserved "apply" keywordLambda               = reserved "lambda" keywordMemoizedLambda       = reserved "memoized-lambda"-keywordMemoize             = reserved "memoize"+keywordMemoize              = reserved "memoize" keywordPatternFunction      = reserved "pattern-function" keywordLetRec               = reserved "letrec" keywordLet                  = reserved "let"

@@ -143,7 +143,7 @@    | LambdaExpr [String] EgisonExpr   | MemoizedLambdaExpr [String] EgisonExpr-  | MemoizeExpr EgisonExpr+  | MemoizeExpr [(EgisonExpr, EgisonExpr, EgisonExpr)] EgisonExpr   | PatternFunctionExpr [String] EgisonPattern      | IfExpr EgisonExpr EgisonExpr EgisonExpr

@@ -4,7 +4,7 @@ ;;;;; ;;;;; -(define $builtin-data-matcher+(define $eq   (matcher-dfs     {[,$val []       {[$tgt (if (eq? val tgt)@@ -14,10 +14,10 @@       {[$tgt {tgt}]}]      }))   -(define $bool builtin-data-matcher)-(define $char builtin-data-matcher)-(define $integer builtin-data-matcher)-(define $float builtin-data-matcher)+(define $bool eq)+(define $char eq)+(define $integer eq)+(define $float eq)  ;; ;; Utility

@@ -263,14 +263,6 @@   (lambda [$x]     {x @(repeat1 x)})) -(define $merge-  (lambda [$xs $ys]-    (match [xs ys] [(list something) (list something)]-      {[[<nil> _] ys]-       [[_ <nil>] xs]-       [[<cons $x $txs> <cons ?(gte? $ x) _>] {x @(merge txs ys)}]-       [[_ <cons $y $tys>] {y @(merge xs tys)}]})))- ;; ;; Others ;;

@@ -34,8 +34,7 @@  (define $prime?   (lambda [$n]-    (not (any 1#(eq? (remainder n %1) 0)-              (while (lte? $ (floor (sqrt (itof n)))) primes)))))+    (eq? n (find-factor n))))  (define $primes {2 @(filter prime? (drop 2 nats))}) @@ -44,9 +43,10 @@     (eq? 0 (remainder n d))))  (define $find-factor-  (lambda [$n]-    (match primes (list integer)-      {[<join _ <cons (& ?(divisor? n $) $x) _>> x]})))+  (memoized-lambda [$n]+    (match (while (lte? $ (floor (sqrt (itof n)))) primes) (list integer)+      {[<join _ <cons (& ?(divisor? n $) $x) _>> x]+       [_ n]})))  (define $prime-factorization   (match-lambda integer

@@ -87,3 +87,24 @@                  [$p (nth (quotient n 2) xs)]                  [[$ys1 $ys2 $ys3] (split-by-ordering/fn f p xs)]}             {@(sort/fn f ys1) @ys2 @(sort/fn f ys3)})]})))++(define $sort-strings+  (lambda [$xs]+    (sort/fn 2#(compare-c (map ctoi (unpack %1)) (map ctoi (unpack %2))) xs)))++(define $merge+  (lambda [$xs $ys]+    (match [xs ys] [(list something) (list something)]+      {[[<nil> _] ys]+       [[_ <nil>] xs]+       [[<cons $x $txs> <cons ?(gte? $ x) _>] {x @(merge txs ys)}]+       [[_ <cons $y $tys>] {y @(merge xs tys)}]})))++(define $merge/fn+  (lambda [$f $xs $ys]+    (match [xs ys] [(list something) (list something)]+      {[[<nil> _] ys]+       [[_ <nil>] xs]+       [[<cons $x $txs> <cons ?1#(eq? (f %1 x) <Greater>) _>] {x @(merge txs ys)}]+       [[_ <cons $y $tys>] {y @(merge xs tys)}]})))+