packages feed

syntax-trees (empty) → 0.1

raw patch · 7 files changed

+322/−0 lines, 7 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.
+ Language/Haskell/SyntaxTrees.lhs view
@@ -0,0 +1,14 @@+> {-+>    Module      : Language.Haskell.SyntaxTrees+>    Copyright   : (c) Dominic Orchard 2010+>    License     : BSD3+>    Maintainer  : Dominic Orchard <dom.orchard@gmail.com>+>    Stability   : experimental+>    Portability : portable (tempalte-haskell)+> -}+++> module Language.Haskell.SyntaxTrees () where++> import Language.Haskell.SyntaxTrees.ExtsToTH+> import Language.Haskell.SyntaxTrees.Main
+ Language/Haskell/SyntaxTrees/ExtsToTH.lhs view
@@ -0,0 +1,199 @@+> {-+>    Module      : Language.Haskell.SyntaxTrees+>    Copyright   : (c) Dominic Orchard 2010+>    License     : BSD3+>    Maintainer  : Dominic Orchard <dom.orchard@gmail.com>+>    Stability   : experimental+>    Portability : portable (tempalte-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 Language.Haskell.SyntaxTrees.ExtsToTH (+>     translateExtsToTH,+>     parseToTH,+>     parseToTarget,+>     translateTree) where++> import Language.Haskell.SyntaxTrees.Main++> import Language.Haskell.Interpreter+> 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.Generics.Uniplate.Data+> import Foreign+> import Control.Monad.State.Lazy+> import qualified Control.Monad.State.Class as State++================================================================================++> instance Translation Exts.Exp TH.Exp where+>   translateTree t = unsafePerformIO $ +>              do mx <- runInterpreter (interpretTH (buildTHString t))+>                 case mx of +>                   Left x -> (return . Left) t+>                   Right x -> x >>= (return . Right)+>+>   parseToTarget witness s = case (parseExp s) of+>                 ParseOk x -> case (translateTree x) of+>                                Left x -> 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 var 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 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 $ 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 = [n | (Exts.PVar (Exts.Ident n)) <- 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 _ _ pats _ _ binds) = getPatBinders pats ++ getBinders binds++> getIPBinders :: Exts.IPBind -> String+> getIPBinders (Exts.IPBind srcLine (Exts.IPDup n) exp) = n+> getIPBinders (Exts.IPBind srcLine (Exts.IPLin n) exp) = 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 x = evalState (transformTopDownM f x) Empty+>   where+>     -- Variable encountered: *** transformation occurs here**+>     f e@(Exts.Var (Exts.UnQual (Exts.Ident n))) = do+>         scopedVars <- State.get+>         if (isFree n scopedVars) then+>             return $ Right (mkFreeVar n)+>          else+>             return $ Left e++>     -- Let binder+>     f e@(Exts.Let binds exp) = do+>         scopedVars <- State.get+>         State.put $ Next (getBinders binds) scopedVars+>         return $ Left e++>     -- Lambda binder+>     f e@(Exts.Lambda srcLine pats exp) = do+>         scopedVars <- State.get+>         State.put $ Next (getPatBinders pats) scopedVars+>         return $ Left e++>     -- Arrow Proc binder+>     f e@(Exts.Proc srcLine pat exp) = do+>         scopedVars <- State.get+>         State.put $ Next (getPatBinders [pat]) scopedVars+>         return $ Left e++>     -- Default case+>     f x = return $ Left x+++ blankSrcLoc = Exts.SrcLoc "" 0 0 + snLoc x = Exts.SrcLoc x 0 0 ++================================================================================++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) => (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''
+ Language/Haskell/SyntaxTrees/Main.lhs view
@@ -0,0 +1,29 @@+> {-+>    Module      : Language.Haskell.SyntaxTrees+>    Copyright   : (c) Dominic Orchard 2010+>    License     : BSD3+>    Maintainer  : Dominic Orchard <dom.orchard@gmail.com>+>    Stability   : experimental+>    Portability : portable (tempalte-haskell)+> -}++> {-# LANGUAGE MultiParamTypeClasses #-}++> module 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+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ examples/Foo.lhs view
@@ -0,0 +1,9 @@+> import 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))"
+ syntax-trees.cabal view
@@ -0,0 +1,39 @@+name:             syntax-trees+version:          0.1+synopsis:         Convert between different Haskell syntax trees.+description:      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.+		  .+license:          BSD3+license-file:     LICENSE+author:           Dominic Orchard+maintainer:       dom.orchard@gmail.com+build-type:       Simple+cabal-version:    >= 1.6+category: 	  Language+extra-source-files:  examples/Foo.lhs++library+  build-depends:    base >= 3 && <5,+                    mtl,+                    haskell-src-exts >=1.2,+                    template-haskell,+                    uniplate,+                    hint+  extensions:       TemplateHaskell, MultiParamTypeClasses+  exposed-modules:  Language.Haskell.SyntaxTrees+                    Language.Haskell.SyntaxTrees.Main+                    Language.Haskell.SyntaxTrees.ExtsToTH+		    +