packages feed

syntax-trees-fork-bairyn (empty) → 0.1.2.5

raw patch · 8 files changed

+405/−0 lines, 8 filesdep +basedep +haskell-src-extsdep +hintsetup-changed

Dependencies added: base, haskell-src-exts, hint, mtl, template-haskell, uniplate

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Dominic Orchard 2010+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Neil Mitchell nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,17 @@+Notes on repository.++This repository hosts currently a fork of Dominic Orchard's syntax-trees+project residing in a VCS repository, git in particular, with the following+branches:++ * master: Currently the branch for the actual fork, for the+     syntax-trees-fork-bairyn package.  Version tags refer to commits in this+     branch.+ * cherry-picked-build-fixes: Contains the initial import of the syntax-trees+     package with just build fixes cherry picked in.+ * cherry-picked-build-and-warning-fixes: Based on cherry-picked-build-fixes,+     this branch adds fixes to warnings, an addition of the "-Wall" flag for+     GHC so that warnings are emitted during the build process, and the+     correction of "template-haskell" typos.+ * fork-no-rename: Based on master, and adds commits that reverses the renaming+     of the fork and module names.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ examples/Foo.lhs view
@@ -0,0 +1,9 @@+> import Fork.Bairyn.Language.Haskell.SyntaxTrees.ExtsToTH+> import qualified Language.Haskell.TH as TH+> import qualified Language.Haskell.Exts.Syntax as Exts++> foo :: Either String TH.Exp+> foo = parseToTH "let x = 1 in x + y"++> foo2 :: Either String TH.Exp+> foo2 = parseToTH "\\x -> (\\y -> (x + y + z))"
+ src/Fork/Bairyn/Language/Haskell/SyntaxTrees.lhs view
@@ -0,0 +1,16 @@+> {-+>    Module      : Fork.Bairyn.Language.Haskell.SyntaxTrees+>    Copyright   : (c) Dominic Orchard 2010+>    License     : BSD3+>    Maintainer  : Dominic Orchard <dom.orchard@gmail.com>+>    Stability   : experimental+>    Portability : portable (template-haskell)+> -}++> module Fork.Bairyn.Language.Haskell.SyntaxTrees+>   ( module Fork.Bairyn.Language.Haskell.SyntaxTrees.ExtsToTH+>   , module Fork.Bairyn.Language.Haskell.SyntaxTrees.Main+>   ) where++> import Fork.Bairyn.Language.Haskell.SyntaxTrees.ExtsToTH+> import Fork.Bairyn.Language.Haskell.SyntaxTrees.Main
+ src/Fork/Bairyn/Language/Haskell/SyntaxTrees/ExtsToTH.lhs view
@@ -0,0 +1,233 @@+> {-+>    Module      : Fork.Bairyn.Language.Haskell.SyntaxTrees+>    Copyright   : (c) Dominic Orchard 2010+>    License     : BSD3+>    Maintainer  : Dominic Orchard <dom.orchard@gmail.com>+>    Stability   : experimental+>    Portability : portable (template-haskell)+> -}++> {-# LANGUAGE MultiParamTypeClasses #-}++> {-| Provides an instance that translates+>   haskell-src-exts expression trees into Template Haskell expression+>   trees in a way that depends only on the haskell-src-exts syntax tree+>   and agreement on the pretty-printed representation of+>   Haskell between haskell-src-exts pretty-printer and+>   Template Haskell quotations (as opposed to depending on+>   both TH and haskell-src-exts syntax tree representations).+>+>+>   Instead of converting between data types,+>   haskell-src-exts syntax trees are pretty-printed and wrapped in+>   a TH quotation which is then interpreted as a Haskell program,+>   yielding a TH Exp tree. Free variables in the haskell-src-exts tree are+>   preserved by lifting them to TH splices prior to pretty-printing.+>+>   e.g. @parseToTH \"let x = 1 in x + y\"@ =+>   @+>       Right (LetE [ValD (VarP x_1) (NormalB (LitE (IntegerL 1))) []]+>         (InfixE (Just (VarE x_1)) (VarE GHC.Num.+) (Just (VarE y))))+>   @+> -}++> module Fork.Bairyn.Language.Haskell.SyntaxTrees.ExtsToTH (+>     translateExtsToTH,+>     parseToTH,+>     parseToTarget,+>     translateTree) where++> import Fork.Bairyn.Language.Haskell.SyntaxTrees.Main++> import Language.Haskell.Interpreter hiding (name)+> import Language.Haskell.Exts.Parser+> import Language.Haskell.Exts.Pretty+> import qualified Language.Haskell.Exts.Syntax as Exts+> import qualified Language.Haskell.TH as TH+> import Data.Data+> import Data.Generics.Uniplate.Data+> import Control.Monad.State.Lazy+> import qualified Control.Monad.State.Class as State+> import System.IO.Unsafe (unsafePerformIO)++================================================================================++> instance Translation Exts.Exp TH.Exp where+>   translateTree t = unsafePerformIO $+>              do mx <- runInterpreter (interpretTH (buildTHString t))+>                 case mx of+>                   Left _ -> (return . Left) t+>                   Right x -> x >>= (return . Right)+>+>   parseToTarget _witness s = case (parseExp s) of+>                 ParseOk ex -> case (translateTree ex) of+>                                Left _ -> Left s+>                                Right x -> Right x+>                 ParseFailed _ string -> Left $ s++string+++> {-| Translate a Language.Haskell.Exts.Exp (haskell-src-exts) syntax tree+>     to a Language.Haskell.TH.Exp (template-haskell) syntax tree -}+> translateExtsToTH :: Exts.Exp -> Either Exts.Exp TH.Exp+> translateExtsToTH = translateTree++> {-| Parse a string to a Language.Haskell.TH.Exp (template-haskell) expression+>   via intermediate representation as a Exts.Exp tree. -}+> parseToTH :: String -> Either String TH.Exp+> parseToTH = parseToTarget (undefined::Exts.Exp)++================================================================================++Build the template Haskell quote expresion++> buildTHString :: Exts.Exp -> String+> buildTHString t = "(runQ [|" ++ (prettyPrint $ liftFreeVars t) ++ "|])::IO Exp"++> interpretTH :: String -> Interpreter (IO TH.Exp)+> interpretTH thString = do+>    set [languageExtensions := [TemplateHaskell]]+>    setImports ["Prelude","Language.Haskell.TH","Language.Haskell.TH.Syntax"]+>    interpret thString (undefined::(IO TH.Exp))++================================================================================++Free variables must be lifted into TemplateHaskell splices, as free variables are not+allowed in a TemplateHaskell quotation. For example:++    [| x |] -> [| $( varE (mkName "x"))$ |]++liftFreeVars processes an Exts.Exp expression, keeping an account in its state of+scoped variables in the following nested scope structure:++> data NestedScopes = Next [String] NestedScopes | Empty deriving Show++isFree is used to ask if an encountered variable name is currently free++> isFree :: String -> NestedScopes -> Bool+> isFree _    Empty = True+> isFree var (Next vars n) = (not $ elem var vars) && isFree var n++Any free variables are converted into an Exts.Exp of a TH splice by mkFreeVar:++> mkFreeVar :: Exts.Name -> Exts.Exp+> mkFreeVar n = Exts.SpliceExp $ Exts.ParenSplice $+>             (Exts.App (Exts.Var (Exts.UnQual $ Exts.Ident "varE"))+>                       (Exts.App (Exts.Var $ Exts.UnQual $ Exts.Ident "mkName")+>                                 (Exts.Lit $ Exts.String $ nameToString $ n)))+++For every binder (e.g. lambdas, lets) we create a new scope in our state+and add the bound variables. The following extract variable names from various+binding forms:++> getPatBinders :: [Exts.Pat] -> [String]+> getPatBinders = concatMap getPatBinders'+>   where+>   getPatBinders' p =+>       [nameToString name | (Exts.PVar name)  <- universe p]++> getBinders :: Exts.Binds -> [String]+> getBinders (Exts.BDecls decls) = concatMap getBinders' decls++>   where getBinders' p = concat ((patBinders p) ++ (matchBinders p))++>         patBinders p = [(getPatBinders [pat])++(getBinders binds) |+>                               (Exts.PatBind _ pat _ binds) <- universe p]++>         matchBinders p = [concatMap getMatchBinders matches |+>                               (Exts.FunBind matches) <- universe p]+> getBinders (Exts.IPBinds ipbinds) = map getIPBinders ipbinds++> getMatchBinders :: Exts.Match -> [String]+> getMatchBinders (Exts.Match _ _ pats _ _ binds) = getPatBinders pats ++ getBinders binds++> getAltBinders :: [Exts.Alt] -> [String]+> getAltBinders = concatMap getAltBinders'+>   where+>   getAltBinders' :: Exts.Alt -> [String]+>   getAltBinders' (Exts.Alt _ pat _ binds) = getPatBinders [pat] ++ getBinders binds+++> getIPBinders :: Exts.IPBind -> String+> getIPBinders (Exts.IPBind _srcLine (Exts.IPDup n) _expr) = n+> getIPBinders (Exts.IPBind _srcLine (Exts.IPLin n) _expr) = n++liftFreeVars processes the tree town down using the uniplate extension:+transformTopDownM (see below) to process the tree top down and to not process newly+generated subtrees.++> liftFreeVars :: Exts.Exp -> Exts.Exp+> liftFreeVars exprTree = evalState (transformTopDownM f exprTree) Empty+>   where+>     -- Qualified variable encountered, transformation occurs here**+>     -- Qualified variables are always 'free'+>     f (Exts.Var (Exts.Qual (Exts.ModuleName m) name)) = do+>           return $ Right $ mkFreeVar $ Exts.Ident $ m ++ "." ++ nameToString name+>     -- Variable encountered: *** transformation occurs here**+>     f e@(Exts.Var (Exts.UnQual name)) = do+>         scopedVars <- State.get+>         if (isFree (nameToString name) scopedVars) then+>             return $ Right (mkFreeVar name)+>          else+>             return $ Left e+>     -- Let binder+>     f e@(Exts.Let binds _expr) = do+>         scopedVars <- State.get+>         State.put $ Next (getBinders binds) scopedVars+>         return $ Left e++>     -- Lambda binder+>     f e@(Exts.Lambda _srcLine pats _expr) = do+>         scopedVars <- State.get+>         State.put $ Next (getPatBinders pats) scopedVars+>         return $ Left e++>     -- Case binder+>     f e@(Exts.Case _expr alts) = do+>         scopedVars <- State.get+>         State.put $ Next (getAltBinders alts) scopedVars+>         return $ Left e++>     -- Arrow Proc binder+>     f e@(Exts.Proc _srcLine pat _expr) = do+>         scopedVars <- State.get+>         State.put $ Next (getPatBinders [pat]) scopedVars+>         return $ Left e++>     -- Arrow Proc binder+>     f (Exts.InfixApp exp1 qop exp2) = do+>         return $ Left $ Exts.App (Exts.App (Exts.Var (qOpToQName qop)) exp1) exp2++>     -- Default case+>     f x = return $ Left x+++ blankSrcLoc = Exts.SrcLoc "" 0 0+ snLoc x = Exts.SrcLoc x 0 0++> qOpToQName :: Exts.QOp -> Exts.QName+> qOpToQName (Exts.QVarOp qnam) = qnam+> qOpToQName (Exts.QConOp qnam) = qnam++> nameToString :: Exts.Name -> String+> nameToString (Exts.Ident  s) = s+> nameToString (Exts.Symbol s) = s+++================================================================================++Extension to Uniplate++Use descendM to do a top-down parse of a uniplatable tree,+but take a function with return type: m (Either on on), with behaviour:+    Descend on a value of Left x+    Stop on a value of Right x, which denotes that a new sub-tree was built that+       shouldn't be parsed over.+++> transformTopDownM :: (Monad m, Uniplate on, Data on) => (on -> m (Either on on)) -> on -> m on+> transformTopDownM f = g+>    where g x = do x' <- (f x)+>                   case x' of+>                     Left x'' -> ((descendM g) =<< (return x''))+>                     Right x'' -> return x''
+ src/Fork/Bairyn/Language/Haskell/SyntaxTrees/Main.lhs view
@@ -0,0 +1,29 @@+> {-+>    Module      : Fork.Bairyn.Language.Haskell.SyntaxTrees+>    Copyright   : (c) Dominic Orchard 2010+>    License     : BSD3+>    Maintainer  : Dominic Orchard <dom.orchard@gmail.com>+>    Stability   : experimental+>    Portability : portable (template-haskell)+> -}++> {-# LANGUAGE MultiParamTypeClasses #-}++> module Fork.Bairyn.Language.Haskell.SyntaxTrees.Main where++> type Witness a = a++> class Translation s t where+>     {-| Translate a tree of type @s@ to a tree of type @t@.++>       If translation fails then @translate s = Left s@, otherwise+>       @translate s = Right t@ where @t@ is the translated tree. -}+>     translateTree :: s -> Either s t+>     {-| Parse a string to a tree of type @t@, via intermediate representation+>       as a tree of type @s@. Requires a witness of the intermediate type @s@+>       to be passed as the first argument.++>       If parsing fails then @parseToTarget s = Left s@, otherwise+>       @parseToTarget s = Right t@ where @t@ is the parsed tree. -}+>     parseToTarget :: Witness s -> String -> Either String t+
+ syntax-trees-fork-bairyn.cabal view
@@ -0,0 +1,69 @@+name:                syntax-trees-fork-bairyn+-- Don't forget to bump the tag too.+version:             0.1.2.5+cabal-version:       >= 1.18+build-type:          Simple+license:             BSD3+license-file:        LICENSE+category:            Language+author:+  Dominic Orchard+ ,Byron Johnson+maintainer:+  dom.orchard@gmail.com+ ,ByronJohnsonFP@gmail.com+extra-source-files:+  examples/Foo.lhs+-- The extra-doc-files property requires cabal-version >= 1.18.+extra-doc-files:+  README.md+synopsis:            Convert between different Haskell syntax trees.  Bairyn's fork.+description:+  This is a fork of Dominic Orchard's syntax-trees package that is patched+  just to build on Haskell's more modern ecosystem.+  .+  Provides an instance that translates haskell-src-exts expression trees into+  Template Haskell expression trees in a way that depends only on the+  haskell-src-exts syntax tree and agreement on the pretty-printed+  representation of Haskell between haskell-src-exts pretty-printer and+  Template Haskell quotations (as opposed to depending on both TH and+  haskell-src-exts syntax tree representations).+  .+  Instead of converting between data types,+  haskell-src-exts syntax trees are pretty-printed and wrapped in+  a TH quotation which is then interpreted as a Haskell program,+  yielding a TH Exp tree. Free variables in the haskell-src-exts tree are+  preserved by lifting them to TH splices prior to pretty-printing.++library+  default-language: Haskell2010+  hs-source-dirs:   src+  ghc-options:      -Wall+  default-extensions:+    --,GADTs+     TemplateHaskell+    --,DeriveDataTypeable+  other-extensions:+    MultiParamTypeClasses+  build-depends:+    base             >= 4    && < 5+   ,mtl+   -- haskell-src-exts introduces a change in the PatBind constructor of+   -- 'Language.Haskell.Syntax.Exts.Syntax.Decl' in version 1.16.0.+   ,haskell-src-exts >= 1.16 && < 2+   ,template-haskell+   ,uniplate+   ,hint+  exposed-modules:+    Fork.Bairyn.Language.Haskell.SyntaxTrees+   ,Fork.Bairyn.Language.Haskell.SyntaxTrees.Main+   ,Fork.Bairyn.Language.Haskell.SyntaxTrees.ExtsToTH++source-repository head+  type:     git+  location: git@github.com:bairyn/syntax-trees.git++source-repository this+  type:     git+  location: git@github.com:bairyn/syntax-trees.git+  tag:      v0.1.2.5