egison 2.1.14 → 2.1.15

raw patch · 4 files changed

+39/−35 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• egison.cabal +1/−1
• etc/template.hs +1/−2
• hs-src/Compiler/egisonc.hs +8/−13
• hs-src/Language/Egison/Types.hs +29/−19

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

@@ -14,8 +14,7 @@   args <- getArgs   env <- primitiveBindings   _ <- loadLibraries env-  _ <- runIOThrows (do topExprs <- liftThrows (readTopExprList program)-                       liftM concat $ mapM (evalTopExpr env) topExprs)+  _ <- runIOThrows $ liftM concat $ mapM (evalTopExpr env) topExprs   _ <- runIOThrows $ evalTopExpr env $ Execute args   return () 

@@ -1,6 +1,7 @@ module Main where import Language.Egison.Core import Language.Egison.Types+import Language.Egison.Parser --import Language.Egison.Variables import Control.Monad.Error import System.Cmd (system)@@ -77,7 +78,7 @@ -- |High level code to compile the given file process :: String -> String -> IO () process inFile outExec = do-  result <- (runIOThrows $ liftM show $ createHaskellFile inFile outExec)+  result <- (runIOThrows $ liftM show $ createHaskellFile inFile)   case result of    Just errMsg -> putStrLn errMsg    _ -> compileHaskellFile outExec@@ -87,23 +88,17 @@ replaceTabToSpace ('\t':cs) = ' ':(replaceTabToSpace cs) replaceTabToSpace (c:cs) = c:(replaceTabToSpace cs) -createHaskellFile :: String -> String -> IOThrowsError ()-createHaskellFile inFile outExec = do+createHaskellFile :: String -> IOThrowsError ()+createHaskellFile inFile = do   templatePath <- liftIO $ getDataFileName templateFile   liftIO $ copyFile templatePath "./_tmp.hs"   egisonProgram <- liftIO $ readFile inFile-  let pLines = lines egisonProgram-  liftIO $ appendFile "./_tmp.hs" "\nprogram :: String\n"-  liftIO $ appendFile "./_tmp.hs" "program = "-  liftIO $ mapM_ (appendFile "./_tmp.hs") $ map (\pLine -> "  \"" ++ escapeDoubleQuote (replaceTabToSpace pLine) ++ "\\n\" ++\n") pLines-  liftIO $ appendFile "./_tmp.hs" "  \"\"\n"+  topExprs <- liftThrows $ readTopExprList egisonProgram+  liftIO $ appendFile "./_tmp.hs" "\ntopExprs :: [TopExpr]\n"+  liftIO $ appendFile "./_tmp.hs" "topExprs = "+  liftIO $ appendFile "./_tmp.hs" $ show topExprs   return () -escapeDoubleQuote :: String -> String-escapeDoubleQuote [] = []-escapeDoubleQuote (c:cs) = case c of-                             '"' -> '\\':'"':(escapeDoubleQuote cs)-                             _ -> c:(escapeDoubleQuote cs)    -- |Compile the intermediate haskell file using GHC compileHaskellFile :: String -> IO()

@@ -76,6 +76,7 @@   | Execute [String]   | LoadFile String   | Load String+ deriving (Show)          data EgisonExpr = CharExpr Char   | StringExpr String@@ -108,6 +109,7 @@   | MatchExpr EgisonExpr EgisonExpr [MatchClause]   | MatchAllExpr EgisonExpr EgisonExpr MatchClause   | ApplyExpr EgisonExpr EgisonExpr+ deriving (Show)  type ArgsExpr = Args                @@ -123,9 +125,11 @@   | PPatChar Char   | PPatNumber Integer   | PPatFloat Double+ deriving (Show)  data InnerExpr = ElementExpr EgisonExpr   | SubCollectionExpr EgisonExpr+ deriving (Show)  type Bindings = [(Args, EgisonExpr)] @@ -180,6 +184,7 @@  data Args = AVar String   | ATuple [Args]+ deriving (Show)    data InnerVal = Element EgisonVal   | SubCollection EgisonVal@@ -265,6 +270,11 @@ unwordsList :: Show a => [a] -> String unwordsList = unwords . map show +-- |Convert a list of Egison expressions into a '_'-separated string+unwordsNumExprs :: [EgisonExpr] -> String+unwordsNumExprs [] = ""+unwordsNumExprs (n:ns) = "_" ++ showExpr n ++ unwordsNumExprs ns+ -- |Convert a list of Egison objects into a '_'-separated string unwordsNums :: Show a => [a] -> String unwordsNums [] = ""@@ -276,12 +286,12 @@ showBindings :: Bindings -> String showBindings [] = "{}" showBindings bindings = "{" ++ unwords (map showBinding bindings) ++ "}"- where showBinding (_,expr) = "[$" ++ "..." ++ " " ++ show expr ++ "]" + where showBinding (_,expr) = "[$" ++ "..." ++ " " ++ showExpr expr ++ "]"   showRecursiveBindings :: RecursiveBindings -> String showRecursiveBindings [] = "{}" showRecursiveBindings bind = "{" ++ unwords (map showBinding bind) ++ "}"- where showBinding (_,expr) = "[$" ++ "..." ++ " " ++ show expr ++ "]" + where showBinding (_,expr) = "[$" ++ "..." ++ " " ++ showExpr expr ++ "]"   showExpr :: EgisonExpr -> String showExpr (CharExpr chr) = [chr]@@ -290,11 +300,11 @@ showExpr (BoolExpr False) = "#f-expr" showExpr (NumberExpr contents) = show contents showExpr (FloatExpr contents) = show contents-showExpr (VarExpr name nums) = name ++ unwordsNums nums-showExpr (SymbolExpr name nums) = "#" ++ name ++ unwordsNums nums-showExpr (PatVarExpr name nums) = "$" ++ name ++ unwordsNums nums+showExpr (VarExpr name nums) = name ++ unwordsNumExprs nums+showExpr (SymbolExpr name nums) = "#" ++ name ++ unwordsNumExprs nums+showExpr (PatVarExpr name nums) = "$" ++ name ++ unwordsNumExprs nums showExpr WildCardExpr = "_"-showExpr (PatVarOmitExpr pvar) = "(omit " ++ show pvar ++ ")"+showExpr (PatVarOmitExpr pvar) = "(omit " ++ showExpr pvar ++ ")" showExpr (CutPatExpr _) = "#<cut-pat>" showExpr (NotPatExpr _) = "#<not-pat>" showExpr (AndPatExpr _) = "#<and-pat>"@@ -306,31 +316,31 @@ showExpr (FuncExpr _ _) =   "(lambda [" ++ "..." ++ "] ...)" showExpr (LoopExpr lVar iVar rExpr lExpr tExpr) =-  "(loop $" ++ lVar ++ " $" ++ iVar ++ " " ++ show rExpr ++ " " ++  show lExpr ++ " " ++ show tExpr ++ ")"+  "(loop $" ++ lVar ++ " $" ++ iVar ++ " " ++ showExpr rExpr ++ " " ++  showExpr lExpr ++ " " ++ showExpr tExpr ++ ")" showExpr (ParamsExpr pVar pExpr body) =-  "(loop $" ++ pVar ++ " " ++ show pExpr ++ " " ++ show body ++ ")"+  "(loop $" ++ pVar ++ " " ++ showExpr pExpr ++ " " ++ showExpr body ++ ")" showExpr (IfExpr condExpr expr1 expr2) =-  "(if " ++ show condExpr ++ " " ++ show expr1 ++ " " ++ show expr2 ++ ")"+  "(if " ++ showExpr condExpr ++ " " ++ showExpr expr1 ++ " " ++ showExpr expr2 ++ ")" showExpr (LetExpr bindings body) =-  "(let " ++ showBindings bindings ++ " " ++ show body ++ ")"+  "(let " ++ showBindings bindings ++ " " ++ showExpr body ++ ")" showExpr (LetRecExpr bindings body) =-  "(letrec " ++ showRecursiveBindings bindings ++ " " ++ show body ++ ")"+  "(letrec " ++ showRecursiveBindings bindings ++ " " ++ showExpr body ++ ")" showExpr (DoExpr bindings body) =-  "(do " ++ showBindings bindings ++ " " ++ show body ++ ")"+  "(do " ++ showBindings bindings ++ " " ++ showExpr body ++ ")" showExpr (TypeExpr bindings) =   "(type " ++ showRecursiveBindings bindings ++ ")" showExpr (TypeRefExpr typExpr name) =-  "(type-ref " ++ show typExpr ++ " " ++ name ++ ")"+  "(type-ref " ++ showExpr typExpr ++ " " ++ name ++ ")" showExpr (DestructorExpr _) = "(destructor ...)" showExpr (MatchExpr tgtExpr typExpr _) =-  "(match " ++ show tgtExpr ++ " " ++ show typExpr ++ " ...)"+  "(match " ++ showExpr tgtExpr ++ " " ++ showExpr typExpr ++ " ...)" showExpr (MatchAllExpr tgtExpr typExpr _) =-  "(match-all " ++ show tgtExpr ++ " " ++ show typExpr ++ " ...)"+  "(match-all " ++ showExpr tgtExpr ++ " " ++ showExpr typExpr ++ " ...)" showExpr (ApplyExpr opExpr argExpr) =-  "(" ++ show opExpr ++ " " ++ show argExpr ++ ")"+  "(" ++ showExpr opExpr ++ " " ++ showExpr argExpr ++ ")"   --- |Allow conversion of egisonexpr instances to strings-instance Show EgisonExpr where show = showExpr+---- |Allow conversion of egisonexpr instances to strings+--instance Show EgisonExpr where show = showExpr                        eqv :: [EgisonVal] -> ThrowsError EgisonVal eqv [(Bool arg1), (Bool arg2)] = return $ Bool $ arg1 == arg2@@ -421,7 +431,7 @@ instance Show IntermidiateVal where show = showIVal  showObj :: Object -> String-showObj (Closure _ expr) = "(Closure env " ++  show expr ++ ")"+showObj (Closure _ expr) = "(Closure env " ++  showExpr expr ++ ")" showObj (Value val) = "(Value " ++ show val ++ ")" showObj (Intermidiate val) = "(Intermidiate " ++ show val ++ ")" showObj (Loop _ _ _ _ _) = "#<loop>"