egison-quote 0.1.0 → 0.1.1

raw patch · 2 files changed

+109/−23 lines, 2 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Language/Egison/Quote.hs +108/−22
• egison-quote.cabal +1/−1

@@ -12,14 +12,17 @@ --  -----------------------------------------------------------------------------    -{-# Language TemplateHaskell, QuasiQuotes, TypeSynonymInstances, FlexibleInstances, UndecidableInstances, OverlappingInstances, IncoherentInstances #-}+{-# Language TemplateHaskell, QuasiQuotes, TypeSynonymInstances, FlexibleInstances, UndecidableInstances, ViewPatterns, OverlappingInstances, IncoherentInstances #-}  module Language.Egison.Quote(egison,                              TypeSignature,-                             parseQuote,                              parseType,+                             pickupAntiquote,+                             parseAntiquote,+                             parseQuote,                              readQuote,-                             toHaskellExp) where+                             toHaskellExp,+                             evalEgisonTopLevel) where  import Language.Haskell.TH import Language.Haskell.TH.Syntax@@ -35,6 +38,9 @@  import Data.Either import Data.Ratio+import Data.Maybe+import Data.List+ import Control.Monad.Error hiding (lift) import Control.Monad.Trans hiding (lift) import Control.Arrow@@ -45,12 +51,13 @@ class IsEgisonExpr a where     toEgisonExpr :: a -> EgisonExpr -instance Integral i => IsEgisonExpr i where toEgisonExpr = NumberExpr . fromIntegral+instance IsEgisonExpr Int where toEgisonExpr = NumberExpr . fromIntegral+instance IsEgisonExpr Integer where toEgisonExpr = NumberExpr . fromIntegral instance IsEgisonExpr Char where toEgisonExpr = CharExpr-instance IsEgisonExpr String where toEgisonExpr = StringExpr instance IsEgisonExpr Bool where toEgisonExpr = BoolExpr instance IsEgisonExpr Float where toEgisonExpr = FloatExpr . realToFrac instance IsEgisonExpr Double where toEgisonExpr = FloatExpr+instance IsEgisonExpr String where toEgisonExpr = StringExpr instance IsEgisonExpr a => IsEgisonExpr [a] where toEgisonExpr = CollectionExpr . map (ElementExpr . toEgisonExpr) instance (IsEgisonExpr a, IsEgisonExpr b) => IsEgisonExpr (a, b) where   toEgisonExpr (x, y) = TupleExpr $ [toEgisonExpr $ x, toEgisonExpr $ y]@@ -67,19 +74,29 @@  -- |  -- QuasiQuoter for egison expression+-- -- The format is: -- -- > expr := [egison | <egison-expression> :: <type-signature> |] --+-- For example, with Egison pattern matching, /powerset function/ can be expressed easily as follows.+--+-- >>> [egison|(lambda [$l] (match-all l (Multiset Integer) [<join $l _> l])) :: [Int] -> [[Int]]|] [1..3]+-- [[],[1],[2],[1,2],[3],[1,3],[2,3],[1,2,3]]+-- -- Type signature is defined as follows -- -- > <Typ> = Bool | Int | Double | Float | Char | String | [<Typ>] | (<Typ>, <Typ>, ..., <Typ>) | <Typ> -> <Typ> -> ... <Typ> -- -- Embedded Egison expression is run-time evaluated by using 'Language.Egison.Core.eval' and 'System.Unsafe.unsafePerformIO'.--- For more detailed usage, please refer to <https://github.com/xenophobia/Egison-Quote>. +-- For more detailed usage, please refer to <https://github.com/xenophobia/Egison-Quote>. egison :: QuasiQuoter egison = QuasiQuoter {-           quoteExp = uncurry toHaskellExp . extractValue . readQuote,+           quoteExp = \input ->+                      let (antiquotes, input') = pickupAntiquote input+                          (expr, typ) = extractValue . readQuote $ input'+                      in+                        toHaskellExp expr antiquotes typ,            quotePat = error "Not implemented pat-quote.",            quoteType = error "Not implemented type-quote.",            quoteDec = error "Not implemented dec-quote."@@ -143,6 +160,25 @@                             return $ if null ttl then thd else TupleTS (thd:ttl))              <|> brackets (ListTS <$> lexeme parseType') +-- | Pick up antiquoted variables and delete notation @#{~}@+-- +-- > "(+ #{x} y)"  ---> ([x], "(+ x y)")+pickupAntiquote :: String -> ([String], String)+pickupAntiquote input = either (error.show) id $ parse parseAntiquote "Antiquote" input++-- | Parser for 'pickupAntiquote'+parseAntiquote :: Parser ([String], String)+parseAntiquote = (try $ do lexeme (char '#')+                           lexeme (char '{')+                           antiquote <- identifier+                           lexeme (char '}')+                           (antiquotes, rest) <- parseAntiquote+                           return $ (antiquote:antiquotes, ' ':antiquote++" "++rest))+                 <|> (try $ do c <- anyChar+                               (antiquotes, rest) <- parseAntiquote+                               return $ (antiquotes, c:rest))+                 <|> (eof >> return ([], ""))+ -- | Parser for egison-quote parseQuote :: Parser (EgisonExpr, TypeSignature) parseQuote = do@@ -214,20 +250,60 @@ -- * Construction Exp  -- | construct Exp from Egison-expression and type signature-toHaskellExp :: EgisonExpr -> TypeSignature -> ExpQ-toHaskellExp (FuncExpr (TupleExpr args) expr) (ArrowTS t1 t2) | length args == length t1 = do-  env <- newName "env"+toHaskellExp :: EgisonExpr -> [String] -> TypeSignature -> ExpQ+toHaskellExp (FuncExpr (TupleExpr args) expr) antiquotes (ArrowTS t1 t2) | length args == length t1 = do   let (argsName, argsType) = unzip . concat $ zipWith argsExpand args t1       argsExpr = zipWith (\aname atype -> sigE (varE (mkName aname)) atype) argsName argsType-      bindEnv = bindS (varP env) [|liftIO primitiveBindings|]-      loadEnv = noBindS [|liftIO (loadLibraries $(varE env))|]-      bindExprs = zipWith (\aname aexpr -> noBindS [|defineVar $(varE env) (aname, []) =<< (liftIO $ makeClosure $(varE env) (toEgisonExpr $(aexpr)))|]) argsName argsExpr+      bindExprs envName = zipWith (\aname aexpr -> noBindS [|runIOThrowsError $ defineVar $(varE envName) (aname, []) =<< (liftIO $ makeClosure $(varE envName) (toEgisonExpr $(aexpr)))|]) argsName argsExpr   (lamE (map toHaskellArgsPat args)-   (appE (varE 'unsafePerformIO) -    (appE (varE 'runIOThrowsError)-     (doE $ bindEnv : loadEnv : (bindExprs ++ [noBindS (appE (appE (varE 'fmap) (converter t2)) [|eval $(varE env) expr|])])))))-toHaskellExp expr typ = appE (converter typ) (appE (varE 'evalEgison) (lift expr))+        (appE (converter t2) (evalEgisonTopLevel expr antiquotes bindExprs)))+toHaskellExp expr antiquotes typ = appE (converter typ) (evalEgisonTopLevel expr antiquotes (const [])) +childExpr :: EgisonExpr -> [EgisonExpr]+childExpr (CharExpr _) = []+childExpr (StringExpr _) = []+childExpr (BoolExpr _) = []+childExpr (NumberExpr _) = []+childExpr (FloatExpr _) = []+childExpr (VarExpr _ cs) = cs+childExpr (MacroVarExpr _ cs) = cs+childExpr (PatVarOmitExpr c) = [c]+childExpr (VarOmitExpr c) = [c]+childExpr (PatVarExpr _ cs) = cs+childExpr WildCardExpr = []+childExpr (ValuePatExpr c) = [c]+childExpr (CutPatExpr c) = [c]+childExpr (NotPatExpr c) = [c]+childExpr (AndPatExpr cs) = cs+childExpr (OrPatExpr cs) = cs+childExpr (PredPatExpr c cs) = c:cs+childExpr (InductiveDataExpr _ cs) = cs+childExpr (TupleExpr cs) = cs+childExpr (CollectionExpr cs) = map go cs+    where go (ElementExpr x) = x+          go (SubCollectionExpr x) = x+childExpr (ArrayExpr cs) = concatMap go cs+    where go (AElementExpr x) = [x]+          go (AInnerArrayExpr xs) = concatMap go xs+childExpr (FuncExpr c1 c2) = [c1, c2]+childExpr (MacroExpr _ c) = [c]+childExpr (LoopExpr _ _ c1 c2 c3) = [c1, c2, c3]+childExpr (ParamsExpr _ c1 c2) = [c1, c2]+childExpr (IfExpr c1 c2 c3) = [c1, c2, c3]+childExpr (LetExpr bs c) = c:concatMap go bs+    where go (x, y) = [x, y]+childExpr (LetRecExpr bs c) = c:map snd bs+childExpr (DoExpr bs c) = c:concatMap go bs+    where go (x, y) = [x, y]+-- childExpr (TypeExpr DestructInfoExpr)+childExpr (MatchExpr c1 c2 ms) = c1:c2:concatMap go ms+    where go (x, y) = [x, y]+childExpr (MatchAllExpr c1 c2 (c3, c4)) = [c1, c2, c3, c4]+childExpr (GenerateArrayExpr c1 c2) = [c1, c2]+childExpr (ApplyExpr c1 c2) = [c1, c2]+childExpr SomethingExpr = []+childExpr UndefinedExpr = []+ argsExpand :: EgisonExpr -> TypeSignature -> [(String, TypeQ)] argsExpand (PatVarExpr a _) t = [(a, tsToType t)] argsExpand (TupleExpr as) (TupleTS ts) = concat $ zipWith argsExpand as ts@@ -237,8 +313,18 @@ toHaskellArgsPat (PatVarExpr a _) = varP (mkName a) toHaskellArgsPat (TupleExpr as) = tupP $ map toHaskellArgsPat as -evalEgison :: EgisonExpr -> EgisonVal-evalEgison expr = unsafePerformIO $ do-  env <- primitiveBindings-  loadLibraries env-  runIOThrowsError $ eval env expr+evalEgison :: EgisonExpr -> Env -> EgisonVal+evalEgison expr env = unsafePerformIO $ runIOThrowsError $ eval env expr++evalEgisonTopLevel :: EgisonExpr -> [String] -> (Name -> [StmtQ]) -> ExpQ+evalEgisonTopLevel expr vars binds = do+  env <- newName "env"+  let exprs = map (varE . mkName) vars+  (appE (varE 'unsafePerformIO)+   (doE (+     [(varP env) `bindS` (varE 'primitiveBindings),+      noBindS (appE (varE 'loadLibraries) (varE env))] ++ +     zipWith (\vname vexpr -> noBindS [|runIOThrowsError $ defineVar $(varE env) (vname, []) =<< (liftIO $ makeClosure $(varE env) (toEgisonExpr $(vexpr)))|]) vars exprs +++     binds env +++     [noBindS (appE (varE 'runIOThrowsError) (appsE [varE 'eval, varE env, [|expr|]]))]+    )))

@@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version:             0.1.0+Version:             0.1.1  -- A short (one-line) description of the package. Synopsis:            A quasi quotes for using Egison expression in Haskell code