egison 3.5.0 → 3.5.1

raw patch · 6 files changed

+26/−47 lines, 6 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 +6/−27
• hs-src/Language/Egison/Parser.hs +0/−4
• hs-src/Language/Egison/Types.hs +4/−9
• lib/core/base.egi +4/−0
• lib/core/collection.egi +11/−6

@@ -1,5 +1,5 @@ Name:                egison-Version:             3.5.0+Version:             3.5.1 Synopsis:            Programming language with non-linear pattern-matching against unfree data Description:   An interpreter for Egison, the programming langugage that realized non-linear pattern-matching against unfree data types.

@@ -169,7 +169,7 @@  evalExpr env (ArrayExpr exprs) = do   refs' <- mapM (newObjectRef env) exprs-  return . Intermediate . IArray $ Array.listArray (0, toInteger ((length exprs) - 1)) refs'+  return . Intermediate . IArray $ Array.listArray (1, toInteger (length exprs)) refs'  evalExpr env (HashExpr assocs) = do   let (keyExprs, exprs) = unzip assocs@@ -203,8 +203,8 @@  evalExpr env (IndexedExpr expr indices) = do   array <- evalExpr env expr-  indices <- mapM (evalExprDeep env) indices-  refArray array indices+  indices' <- mapM (evalExprDeep env) indices+  refArray array indices'  evalExpr env (LambdaExpr names expr) = return . Value $ Func env names expr @@ -288,27 +288,6 @@   evalExprDeep env expr1   evalExpr env expr2 -evalExpr env@(loopCxts, frames) (LoopExpr name (LoopRange start end WildCard) expr1 expr2) = do-  startNum <- evalExpr env start >>= fromWHNF-  startNumRef <- newEvalutedObjectRef $ Value $ Integer startNum-  end' <- evalExpr env end-  endRef <- newEvalutedObjectRef end'-  endNum <- evalRef endRef >>= fromWHNF-  if startNum > endNum-    then evalExpr (loopCxts, frames) expr2-    else evalExpr (((LoopExprContext (name, startNumRef) endRef expr1 expr2):loopCxts), frames) expr1--evalExpr env@(loopCxts, frames) ContExpr = do-  case loopCxts of-    [] -> throwError $ strMsg "cannot use cont expr except in loop expr"-    ((LoopExprContext (name, startNumRef) endRef expr1 expr2):loopCxts') -> do-      startNum <- evalRef startNumRef >>= fromWHNF-      nextNumRef <- newEvalutedObjectRef $ Value $ Integer (startNum + 1)-      endNum <- evalRef endRef >>= fromWHNF-      if startNum >= endNum-       then evalExpr (loopCxts', frames) expr2-       else evalExpr (((LoopExprContext (name, nextNumRef) endRef expr1 expr2):loopCxts'), frames) expr1- evalExpr env (ApplyExpr func arg) = do   func <- evalExpr env func   arg <- evalExpr env arg@@ -343,8 +322,8 @@   evalExpr env expr >>= arraySize   where     arraySize :: WHNFData -> EgisonM WHNFData-    arraySize (Intermediate (IArray arr)) = return . Value . toEgison $ (snd $ Array.bounds arr) + 1-    arraySize (Value (Array arr))         = return . Value . toEgison $ (snd $ Array.bounds arr) + 1+    arraySize (Intermediate (IArray arr)) = return . Value . toEgison $ snd $ Array.bounds arr+    arraySize (Value (Array arr))         = return . Value . toEgison $ snd $ Array.bounds arr     arraySize val                          = throwError $ TypeMismatch "array" val  evalExpr _ SomethingExpr = return $ Value Something@@ -418,7 +397,7 @@ generateArray env name sizeExpr expr = do   size <- evalExpr env sizeExpr >>= fromWHNF >>= return . fromInteger   elems <- mapM genElem (enumFromTo 1 size)-  return $ Intermediate $ IArray $ Array.listArray (0, size - 1) elems+  return $ Intermediate $ IArray $ Array.listArray (1, size) elems   where     genElem :: Integer -> EgisonM ObjectRef     genElem i = do env' <- bindEnv env name $ toInteger i

@@ -184,7 +184,6 @@                          <|> matcherBFSExpr                          <|> matcherDFSExpr                          <|> seqExpr-                         <|> loopExpr                          <|> applyExpr                          <|> algebraicDataMatcherExpr                          <|> generateArrayExpr@@ -352,9 +351,6 @@  seqExpr :: Parser EgisonExpr seqExpr = keywordSeq >> SeqExpr <$> expr <*> expr--loopExpr :: Parser EgisonExpr-loopExpr = keywordLoop >> LoopExpr <$> varName <*> loopRange <*> expr <*> expr  contExpr :: Parser EgisonExpr contExpr = reservedOp "..." >> pure ContExpr

@@ -42,7 +42,6 @@     , nullEnv     , extendEnv     , refVar-    , LoopExprContext (..)     -- * Pattern matching     , Match     , PMMode (..)@@ -162,7 +161,6 @@   | IoExpr EgisonExpr        | SeqExpr EgisonExpr EgisonExpr-  | LoopExpr String LoopRange EgisonExpr EgisonExpr   | ContExpr   | ApplyExpr EgisonExpr EgisonExpr @@ -514,22 +512,19 @@ -- Environment -- -type Env = ([LoopExprContext], [HashMap Var ObjectRef])+type Env = [HashMap Var ObjectRef] type Var = String type Binding = (Var, ObjectRef)  nullEnv :: Env-nullEnv = ([], [])+nullEnv = []  extendEnv :: Env -> [Binding] -> Env-extendEnv env = ([],) . (: (snd env)) . HashMap.fromList+extendEnv env = (: env) . HashMap.fromList  refVar :: Env -> Var -> EgisonM ObjectRef refVar env var = maybe (throwError $ UnboundVariable var) return-                       (msum $ map (HashMap.lookup var) (snd (extendEnv env (map (\(LoopExprContext binding _ _ _) -> binding) (fst env)))))--data LoopExprContext = LoopExprContext Binding ObjectRef EgisonExpr EgisonExpr- deriving (Show)+                       (msum $ map (HashMap.lookup var) env)  -- -- Pattern Match

@@ -55,3 +55,7 @@   (lambda [$f $g $h]     (lambda $x       (apply h (apply g (apply f x))))))++(define $ref+  (lambda [$xa $i]+    (array-ref xa i)))

@@ -26,10 +26,12 @@          [_ {}]}]        [<join $ $> [(list a) (list a)]         {[$tgt (match-all tgt (list a)-                 [(loop $i [1 $n] <cons $xa_i ...> $rs) [(loop $i [1 n] {xa_i @...} {}) rs]])]}]+                 [(loop $i [1 $n] <cons $xa_i ...> $rs) [(foldr (lambda [$i $r] {xa_i @r}) {} (between 1 n))+                                                         rs]])]}]        [<nioj $ $> [(list a) (list a)]         {[$tgt (match-all tgt (list a)-                 [(loop $i [1 $n] <snoc $xa_i ...> $rs) [(loop $i [1 n] {xa_i @...} {}) rs]])]}]+                 [(loop $i [1 $n] <snoc $xa_i ...> $rs) [(foldr (lambda [$i $r] {xa_i @r}) {} (between 1 n))+                                                         rs]])]}]        [$ [something]         {[$tgt {tgt}]}]        })))@@ -48,10 +50,12 @@        [<join $ <cons ,$px $>> [(ordered-list a) (ordered-list a)]         {[{} {}]          [$tgt (match-all tgt (list a)-                 [(loop $i [1 $n] <cons (& ?(lt? $ px) $xa_i) ...> <cons ,px $rs>) [(loop $i [1 n] {xa_i @...} {}) rs]])]}]+                 [(loop $i [1 $n] <cons (& ?(lt? $ px) $xa_i) ...> <cons ,px $rs>) [(foldr (lambda [$i $r] {xa_i @r}) {} (between 1 n))+                                                                                    rs]])]}]        [<join $ $> [(ordered-list a) (ordered-list a)]         {[$tgt (match-all tgt (list a)-                 [(loop $i [1 $n] <cons $xa_i ...> $rs) [(loop $i [1 n] {xa_i @...} {}) rs]])]}]+                 [(loop $i [1 $n] <cons $xa_i ...> $rs) [(foldr (lambda [$i $r] {xa_i @r}) {} (between 1 n))+                                                         rs]])]}]        [<cons ,$px $> [(ordered-list a)]         {[{$x @$xs} (if (gt? x px)                       {}@@ -62,7 +66,8 @@          [_ {}]}]        [<nioj $ $> [(ordered-list a) (ordered-list a)]         {[$tgt (match-all tgt (list a)-                 [(loop $i [1 $n] <snoc $xa_i ...> $rs) [(loop $i [1 n] {xa_i @...} {}) rs]])]}]+                 [(loop $i [1 $n] <snoc $xa_i ...> $rs) [(foldr (lambda [$i $r] {xa_i @r}) {} (between 1 n))+                                                         rs]])]}]        [<snoc ,$px $> [a (ordered-list a)]         {[{@$xs $x} (if (lt? x px)                       {}@@ -90,7 +95,7 @@       {s}       (if (lt? s e)         {s @(between (+ s 1) e)}-        {s @(between (- s 1) e)}))))+        {}))))  (define $from   (lambda [$s]