syntax-trees 0.1 → 0.1.2
raw patch · 2 files changed
+39/−8 lines, 2 filesnew-uploader
Files
Language/Haskell/SyntaxTrees/ExtsToTH.lhs view
@@ -111,7 +111,7 @@ > 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)))+> (Exts.Lit $ Exts.String $ nameToString $ n))) For every binder (e.g. lambdas, lets) we create a new scope in our state@@ -120,7 +120,9 @@ > getPatBinders :: [Exts.Pat] -> [String] > getPatBinders = concatMap getPatBinders' -> where getPatBinders' p = [n | (Exts.PVar (Exts.Ident n)) <- universe p]+> where+> getPatBinders' p =+> [nameToString name | (Exts.PVar name) <- universe p] > getBinders :: Exts.Binds -> [String] > getBinders (Exts.BDecls decls) = concatMap getBinders' decls@@ -136,6 +138,13 @@ > 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) exp) = n > getIPBinders (Exts.IPBind srcLine (Exts.IPLin n) exp) = n@@ -147,14 +156,17 @@ > liftFreeVars :: Exts.Exp -> Exts.Exp > liftFreeVars x = evalState (transformTopDownM f x) Empty > where+> -- Qualified variable encountered, transformation occurs here**+> -- Qualified variables are always 'free'+> f e@(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 (Exts.Ident n))) = do+> f e@(Exts.Var (Exts.UnQual name)) = do > scopedVars <- State.get-> if (isFree n scopedVars) then-> return $ Right (mkFreeVar n)+> if (isFree (nameToString name) scopedVars) then+> return $ Right (mkFreeVar name) > else > return $ Left e- > -- Let binder > f e@(Exts.Let binds exp) = do > scopedVars <- State.get@@ -167,18 +179,37 @@ > State.put $ Next (getPatBinders pats) scopedVars > return $ Left e +> -- Case binder+> f e@(Exts.Case exp alts) = do+> scopedVars <- State.get+> State.put $ Next (getAltBinders alts) 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 +> -- 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 + 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+ ================================================================================
syntax-trees.cabal view
@@ -1,5 +1,5 @@ name: syntax-trees-version: 0.1+version: 0.1.2 synopsis: Convert between different Haskell syntax trees. description: Provides an instance that translates haskell-src-exts expression trees into Template Haskell expression