egison 2.1.15 → 2.1.16

raw patch · 6 files changed

+154/−19 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• egison.cabal +2/−2
• elisp/egison-mode.el +1/−0
• hs-src/Language/Egison/Core.hs +20/−1
• hs-src/Language/Egison/Macro.hs +88/−0
• hs-src/Language/Egison/Parser.hs +27/−11
• hs-src/Language/Egison/Types.hs +16/−5

@@ -1,5 +1,5 @@ Name:                egison-Version:             2.1.15+Version:             2.1.16 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.@@ -29,10 +29,10 @@   Exposed-Modules: Language.Egison.Core                    Language.Egison.Types                    Language.Egison.Variables---                   Language.Egison.Compiler                    Language.Egison.Numerical                    Language.Egison.Parser                    Language.Egison.Primitives+                   Language.Egison.Macro   Other-modules:   Paths_egison  

@@ -26,6 +26,7 @@      "\\\~"
      "\\\#"
      "|"
+     "%"
      "\\\&"
      "@"
      "\\<_\\>"

@@ -4,6 +4,7 @@ import Language.Egison.Primitives import Language.Egison.Types import Language.Egison.Variables+import Language.Egison.Macro import Control.Monad.Error import Data.Array import qualified Data.Map@@ -193,6 +194,8 @@   return $ Value $ AndPat patObjRefs cEval1 (Closure env (FuncExpr args body)) = do   return $ Value $ Func args body env+cEval1 (Closure _ (MacroExpr args body)) = do+  return $ Value $ Macro args body cEval1 (Closure env (IfExpr condExpr expr1 expr2)) = do   obj <- cEval1 $ Closure env condExpr   case obj of@@ -268,6 +271,10 @@     Value (Func fArgs body cEnv) -> do frame <- liftIO (makeClosure env argExpr) >>= makeFrame fArgs                                        newEnv <- liftIO $ extendEnv cEnv frame                                        cEval1 (Closure newEnv body)+    Value (Macro mArgs body) -> do argExprs <- liftThrows $ tupleExprToExprList argExpr+                                   newBody <- expandMacro (Data.Map.fromList (zip mArgs argExprs)) body+                                   liftIO $ putStrLn $ showExpr newBody+                                   cEval1 (Closure env newBody)     _ -> throwError $ Default "not function" cEval1 val = return val @@ -275,7 +282,9 @@ cApply1 fnObjRef argObjRef = do   fnObj <- cRefEval1 fnObjRef   case fnObj of-    Value (IOFunc fn) -> throwError $ Default "undefined ioFunc"+    Value (IOFunc fn) -> do arg <- cRefEval argObjRef+                            val <- fn (tupleToList arg)+                            return $ Value val     Value (PrimitiveFunc fn) -> do arg <- cRefEval argObjRef                                    val <- liftThrows $ fn (tupleToList arg)                                    return $ Value val@@ -336,6 +345,16 @@       return $ concat frames     _ -> throwError $ Default "makeFrame: not tuple" +tupleExprToExprList :: EgisonExpr -> ThrowsError [EgisonExpr]+tupleExprToExprList (TupleExpr innerExprs) = innerExprsToExprList innerExprs+tupleExprToExprList expr = return [expr]++innerExprsToExprList :: [InnerExpr] -> ThrowsError [EgisonExpr]+innerExprsToExprList [] = return []+innerExprsToExprList ((ElementExpr expr):rest) = do retRest <- innerExprsToExprList rest+                                                    return (expr:retRest)+innerExprsToExprList ((SubCollectionExpr _):_) = throwError $ Default "innerExprsToExprList: subcollection is not supported"+     innerValRefsToObjRefList :: [InnerValRef] -> IOThrowsError [ObjectRef] innerValRefsToObjRefList [] = return [] innerValRefsToObjRefList (innerRef:rest) = do

@@ -0,0 +1,88 @@+module Language.Egison.Macro where+import Language.Egison.Types+import qualified Data.Map++type MacroFrame = Data.Map.Map String EgisonExpr++getExpr :: MacroFrame -> String -> Maybe EgisonExpr+getExpr frame name = Data.Map.lookup name frame++expandMacro :: MacroFrame -> EgisonExpr -> IOThrowsError EgisonExpr+expandMacro frame (VarExpr name []) =+  case getExpr frame name of+    Nothing -> return $ MacroVarExpr name []+    Just expr -> return expr+expandMacro frame (PatVarOmitExpr expr) = do+  newExpr <- expandMacro frame expr+  case newExpr of+    MacroVarExpr name numExprs -> return $ PatVarExpr name numExprs+    _ -> return $ PatVarOmitExpr newExpr+expandMacro frame (VarOmitExpr expr) = do+  newExpr <- expandMacro frame expr+  case newExpr of+    MacroVarExpr name numExprs -> return $ VarExpr name numExprs+    _ -> return $ VarOmitExpr newExpr+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 (CollectionExpr innerExprs) = do+  newInnerExprs <- mapM (expandMacroInnerExpr frame) innerExprs+  return $ CollectionExpr newInnerExprs+expandMacro frame (PredPatExpr predName argExprs) = do+  newArgExprs <- mapM (expandMacro frame) argExprs+  return $ PredPatExpr predName newArgExprs+expandMacro frame (CutPatExpr patExpr) = do+  newPatExpr <- expandMacro frame patExpr+  return $ CutPatExpr newPatExpr+expandMacro frame (NotPatExpr patExpr) = do+  newPatExpr <- expandMacro frame patExpr+  return $ CutPatExpr newPatExpr+expandMacro frame (OrPatExpr patExprs) = do+  newPatExprs <- mapM (expandMacro frame) patExprs+  return $ OrPatExpr newPatExprs+expandMacro frame (AndPatExpr patExprs) = do+  newPatExprs <- mapM (expandMacro frame) patExprs+  return $ AndPatExpr newPatExprs+expandMacro frame (FuncExpr args body) = do+  newBody <- expandMacro frame body+  return $ FuncExpr args newBody+expandMacro frame (IfExpr condExpr expr1 expr2) = do+  newCondExpr <- expandMacro frame condExpr+  newExpr1 <- expandMacro frame expr1+  newExpr2 <- expandMacro frame expr2+  return $ IfExpr newCondExpr newExpr1 newExpr2+expandMacro frame (LoopExpr loopVar indexVar rangeExpr loopExpr tailExpr) = do+  newRangeExpr <- expandMacro frame rangeExpr+  newLoopExpr <- expandMacro frame loopExpr+  newTailExpr <- expandMacro frame tailExpr+  return $ LoopExpr loopVar indexVar newRangeExpr newLoopExpr newTailExpr+--expandMacro frame (LetExpr bindings body) = undefined+--expandMacro frame (LetRecExpr bindings body) = undefined+expandMacro frame (MatchExpr tgtExpr typExpr mcs) = do+  newTgtExpr <- expandMacro frame tgtExpr+  newTypExpr <- expandMacro frame typExpr+  newMcs <- mapM (expandMacroMatchClause frame) mcs+  return $ MatchExpr newTgtExpr newTypExpr newMcs+expandMacro frame (MatchAllExpr tgtExpr typExpr mc) = do+  newTgtExpr <- expandMacro frame tgtExpr+  newTypExpr <- expandMacro frame typExpr+  newMc <- expandMacroMatchClause frame mc+  return $ MatchAllExpr newTgtExpr newTypExpr newMc+expandMacro _ expr = return expr++expandMacroMatchClause :: MacroFrame -> MatchClause -> IOThrowsError MatchClause+expandMacroMatchClause frame (patExpr, body) = do+  newPatExpr <- expandMacro frame patExpr+  newBody <- expandMacro frame body+  return (newPatExpr, newBody)++expandMacroInnerExpr :: MacroFrame -> InnerExpr -> IOThrowsError InnerExpr+expandMacroInnerExpr frame (ElementExpr expr) = do+  newExpr <- expandMacro frame expr+  return $ ElementExpr newExpr+expandMacroInnerExpr frame (SubCollectionExpr expr) = do+  newExpr <- expandMacro frame expr+  return $ SubCollectionExpr newExpr

@@ -228,16 +228,25 @@ parsePatVar = do (name, nums) <- parsePatVar2                  return $ PatVarExpr name nums                     -parseSymbol2 :: Parser VarExpr-parseSymbol2 = do char '#'-                  name <- identifier-                  nums <- lexeme parseIndexNums-                  return (name, nums)+parseMacroVarExpr :: Parser EgisonExpr+parseMacroVarExpr = do+  char '%'+  name <- identifier+  nums <- lexeme parseIndexNums+  return $ MacroVarExpr name nums -parseSymbol :: Parser EgisonExpr-parseSymbol = do (name, nums) <- parseSymbol2-                 return $ SymbolExpr name nums-               +parsePatVarOmitExpr :: Parser EgisonExpr+parsePatVarOmitExpr = do+  string "$~"+  expr <- lexeme parseExpr+  return $ PatVarOmitExpr expr++parseVarOmitExpr :: Parser EgisonExpr+parseVarOmitExpr = do+  char '~'+  expr <- lexeme parseExpr+  return $ VarOmitExpr expr+ parseArgs :: Parser ArgsExpr parseArgs = do       try (do (name, _) <- lexeme parsePatVar2@@ -370,9 +379,10 @@   <|> lexeme parseChar   <|> lexeme parseString   <|> try (lexeme parseBool)-  <|> try (lexeme parseSymbol)   <|> try (lexeme parsePattern)---  <|> lexeme parsePatVarOmitExpr+  <|> lexeme parseMacroVarExpr+  <|> lexeme parsePatVarOmitExpr+  <|> lexeme parseVarOmitExpr   <|> lexeme parseVar   <|> angles (do cons <- lexeme identifier                  argExprs <- sepEndBy parseExpr whiteSpace@@ -385,6 +395,12 @@                  args <- lexeme parseArgs                  body <- lexeme parseExpr                  return (FuncExpr args body)+          <|> do try (string "macro" >> many1 space)+                 args <- lexeme (brackets (sepEndBy (do (name, _) <- parsePatVar2+                                                        return name)+                                                    whiteSpace))+                 body <- lexeme parseExpr+                 return (MacroExpr args body)           <|> do try (string "if" >> many1 space)                  condExpr <- lexeme parseExpr                  expr1 <- lexeme parseExpr

@@ -84,10 +84,11 @@   | NumberExpr Integer   | FloatExpr Double   | VarExpr String [EgisonExpr]-  | SymbolExpr String [EgisonExpr]+  | MacroVarExpr String [EgisonExpr]+  | PatVarOmitExpr EgisonExpr+  | VarOmitExpr EgisonExpr   | PatVarExpr String [EgisonExpr]   | WildCardExpr-  | PatVarOmitExpr EgisonExpr   | CutPatExpr EgisonExpr   | NotPatExpr EgisonExpr   | AndPatExpr [EgisonExpr]@@ -97,6 +98,7 @@   | TupleExpr [InnerExpr]   | CollectionExpr [InnerExpr]   | FuncExpr Args EgisonExpr+  | MacroExpr [String] EgisonExpr   | LoopExpr String String EgisonExpr EgisonExpr EgisonExpr   | ParamsExpr String EgisonExpr EgisonExpr   | IfExpr EgisonExpr EgisonExpr EgisonExpr@@ -166,6 +168,7 @@   | Type Frame   | Destructor DestructInfo   | Func Args EgisonExpr Env+  | Macro [String] EgisonExpr   | PrimitiveFunc ([EgisonVal] -> ThrowsError EgisonVal)   | IOFunc ([EgisonVal] -> IOThrowsError EgisonVal)   | Port String Handle@@ -270,6 +273,10 @@ unwordsList :: Show a => [a] -> String unwordsList = unwords . map show +-- |Convert a list of Egison expressions into a space-separated string+unwordsExpr :: [EgisonExpr] -> String+unwordsExpr = unwords . map showExpr+ -- |Convert a list of Egison expressions into a '_'-separated string unwordsNumExprs :: [EgisonExpr] -> String unwordsNumExprs [] = ""@@ -301,20 +308,24 @@ showExpr (NumberExpr contents) = show contents showExpr (FloatExpr contents) = show contents showExpr (VarExpr name nums) = name ++ unwordsNumExprs nums-showExpr (SymbolExpr name nums) = "#" ++ name ++ unwordsNumExprs nums+showExpr (MacroVarExpr name nums) = "%" ++ name ++ unwordsNumExprs nums showExpr (PatVarExpr name nums) = "$" ++ name ++ unwordsNumExprs nums showExpr WildCardExpr = "_"-showExpr (PatVarOmitExpr pvar) = "(omit " ++ showExpr pvar ++ ")"+showExpr (PatVarOmitExpr pvar) = "$~" ++ showExpr pvar+showExpr (VarOmitExpr pvar) = "~" ++ showExpr pvar showExpr (CutPatExpr _) = "#<cut-pat>" showExpr (NotPatExpr _) = "#<not-pat>" showExpr (AndPatExpr _) = "#<and-pat>" showExpr (OrPatExpr _) = "#<or-pat>" showExpr (PredPatExpr _ _) = "#<pred-pat>"-showExpr (InductiveDataExpr cons _) = "<" ++ cons ++ "...>"+showExpr (InductiveDataExpr cons []) = "<" ++ cons ++ ">"+showExpr (InductiveDataExpr cons exprs) = "<" ++ cons ++ " " ++ unwordsExpr exprs ++ ">" showExpr (TupleExpr _) = "[...]" showExpr (CollectionExpr _) = "{...}" showExpr (FuncExpr _ _) =   "(lambda [" ++ "..." ++ "] ...)"+showExpr (MacroExpr _ _) =+  "(macro [" ++ "..." ++ "] ...)" showExpr (LoopExpr lVar iVar rExpr lExpr tExpr) =   "(loop $" ++ lVar ++ " $" ++ iVar ++ " " ++ showExpr rExpr ++ " " ++  showExpr lExpr ++ " " ++ showExpr tExpr ++ ")" showExpr (ParamsExpr pVar pExpr body) =