murder 1.3.1 → 1.3.2
raw patch · 7 files changed
+99/−54 lines, 7 files
Files
- examples/LangDef.hs +1/−44
- examples/LangExt.hs +34/−3
- murder.cabal +4/−2
- src/Language/Grammars/Grammar.hs +8/−5
- src/Language/Grammars/Grammar/AG.hs +23/−0
- src/Language/Grammars/Grammar/AspectAG.hs +21/−0
- src/Language/Grammars/Murder.hs +8/−0
examples/LangDef.hs view
@@ -10,6 +10,7 @@ import Language.Grammars.Murder import Language.Grammars.Grammar+import Language.Grammars.Grammar.AspectAG import Language.Grammars.Murder.Scanner @@ -41,50 +42,6 @@ . export ntTerm term . export ntFactor factor -{--prds = proc () -> do-- rec root <- addNT -< (iI (`semAGItf` emptyRecord) (ch_expr <=> exp) Ii)- exp <- addNT -< (iI semLet "let" (ch_lnm <=> var) "=" (ch_val <=> exp) "in" (ch_body <=> exp) Ii)- <|>- (iI semAdd (ch_ae1 <=> exp) "+" (ch_ae2 <=> term) Ii)- <|>- ntPrd term- term <- addNT -< (iI semMul (ch_me1 <=> term) "*" (ch_me2 <=> factor) Ii)- <|>- ntPrd factor-- factor <- addNT -< (iI semCst (ch_cv <=> int) Ii)- <|> - (iI semVar (ch_vnm <=> var) Ii)-- exportNTs -< exportList root $ export ntExp exp - . export ntTerm term - . export ntFactor factor --} -{---- another possible version-prds = proc () -> do-- rec root <- addNT -< (`semAGItf` emptyRecord) <$> ch_expr <=> exp- exp <- addNT -< semLet <$ tr "let" <*> ch_lnm <=> var <* tr "=" <*> ch_val <=> exp <* tr "in" <*> ch_body <=> exp- <|>- semAdd <$> ch_ae1 <=> exp <* tr "+" <*> ch_ae2 <=> term- <|>- ntPrd term- term <- addNT -< semMul <$> ch_me1 <=> term <* tr "*" <*> ch_me2 <=> factor- <|>- ntPrd factor-- factor <- addNT -< semCst <$> ch_cv <=> int- <|> - semVar <$> ch_vnm <=> var-- exportNTs -< exportList root $ export ntExp exp - . export ntTerm term - . export ntFactor factor ---} {- gramOpts :: ScanOpts
examples/LangExt.hs view
@@ -1,5 +1,5 @@ {-# OPTIONS -fcontext-stack=100 #-}-{-# LANGUAGE Arrows, DoRec, EmptyDataDecls, FlexibleContexts, TemplateHaskell, NoMonomorphismRestriction,+{-# LANGUAGE Arrows, DoRec, EmptyDataDecls, FlexibleContexts, TemplateHaskell, NoMonomorphismRestriction, GADTs, RankNTypes #-} module LangExt where@@ -13,7 +13,8 @@ import Language.Grammars.AspectAG.Derive import Language.Grammars.Murder-import Language.Grammars.Grammar hiding ((<=>))+import Language.Grammars.Grammar +import Language.Grammars.Grammar.AspectAG import LangSem@@ -25,7 +26,8 @@ import Data.HList.TypeEqGeneric1 import Data.HList.TypeCastGeneric1 -+import Language.AbstractSyntax.TTTAS (match, Equal(..))+import Debug.Trace -- modifications of the semantics synM = synmodM@@ -154,6 +156,7 @@ , GetNT NTFactor (nts env) (Symbol AttExpr TNonT env)) => GramExt env start nts start nts -}+{- prds' = proc imported -> do let exp = getNT ntExp imported let term = getNT ntTerm imported@@ -168,8 +171,36 @@ addProds -< (factor, ( iI semPar "(" exp ")" Ii ) ) exportNTs -< imported+-}+prds' = proc imported -> do+ let exp = getNT ntExp imported+ let term = getNT ntTerm imported+ let factor = getNT ntFactor imported + + unary <- Language.Grammars.Murder.addNT -< ( iI semSq "square" factor Ii) + <|> ( iI semPyth "pyth" factor factor Ii) + <|> ( iI semAddSq "addsq" factor factor Ii)+ <|> ( iI factor Ii )+ updProds -< (term, mapNTProds factor unary ) + addProds -< (exp, ( iI semSubst exp "[" var "|" exp "]" Ii))++ + addProds -< (factor, ( iI semPar "(" exp ")" Ii ) )+ + exportNTs -< imported++mapNTProds :: Symbol b TNonT env -> Symbol b TNonT env -> PreProductions TL env a -> PreProductions TL env a+mapNTProds s1 s2 (PP prds) = PP $ map (mapNTProd s1 s2) prds+++mapNTProd :: Symbol b TNonT env -> Symbol b TNonT env -> Prod TL a env -> Prod TL a env+mapNTProd r1 r2 (Star f g) = Star (mapNTProd r1 r2 f) (mapNTProd r1 r2 g)+mapNTProd (Nont r1) (Nont r2) (Sym (Nont r)) = case match r1 r of + (Just Eq) -> Sym (Nont r2)+ _Nothing -> Sym (Nont r)+mapNTProd _ _ p = p --gramOpts' gramOpts = gramOpts `extKeywordsTxt` [ "square", "pyth" ] `extSpecChars` "()[|]"
murder.cabal view
@@ -1,5 +1,5 @@ name: murder -version: 1.3.1+version: 1.3.2 cabal-version: >= 1.2.3 license: LGPL license-file: COPYRIGHT@@ -15,7 +15,9 @@ library build-depends: base>=4 && <5, template-haskell>=2.4.0.1, TTTAS>=0.4.1, AspectAG>=0.3.6.1, uulib>=0.9.12, uu-parsinglib >= 2.7.3.4, ListLike >= 3.1.0, containers>=0.3, HList>=0.2- exposed-modules: Language.Grammars.Grammar, + exposed-modules: Language.Grammars.Grammar,+ Language.Grammars.Grammar.AspectAG, + Language.Grammars.Grammar.AG, Language.Grammars.Murder, Language.Grammars.Murder.Derive, Language.Grammars.Murder.Scanner,
src/Language/Grammars/Grammar.hs view
@@ -4,7 +4,7 @@ module Language.Grammars.Grammar where import Language.AbstractSyntax.TTTAS-import Data.HList+--import Data.HList import Control.Applicative @@ -241,9 +241,10 @@ instance Idiomatic l env f g => Idiomatic l env (a -> f) (Symbol a TNonT env -> g) where idiomatic isf is = idiomatic (isf <*> (sym is)) +{- instance Idiomatic l env f g => Idiomatic l env ((Record HNil -> a) -> f) (Symbol a TAttT env -> g) where idiomatic isf is = idiomatic (isf <*> ((\x (Record HNil) -> x) <$> (sym is :: PreProductions l env a)))-+-} instance Idiomatic l env f g => Idiomatic l env ((a -> b) -> f) ((a -> b) -> g) where idiomatic isf f = idiomatic (isf <*> (pure f :: PreProductions l env (a->b)))@@ -258,13 +259,14 @@ kw :: String -> Kw kw = Kw +{- instance Idiomatic l env f g => Idiomatic l env ((Record HNil -> DTerm String) -> f) (Kw -> g) where idiomatic isf (Kw is) = idiomatic (isf <*> ((\x (Record HNil) -> x) <$> (tr is)))-+-} ------------------------------------------------------------------------------- -+{- newtype LSPair nt a t env = LSPair { symLSPair :: (Symbol a t env) } labelLSPair :: LSPair nt a t env -> nt@@ -283,12 +285,13 @@ instance LabelSymbol TAttT v (Record HNil -> v) where l <=> v = (\x -> l .=. (\(Record HNil) -> x)) <$> (sym v) + instance LabelSymbol TNonT v v where l <=> v = (l .=.) <$> (sym v) instance LabelSymbol TTerm v v where -- only to have all the instances l <=> v = (l .=.) <$> (sym v)-+-} {- -------------------------------------------------------------------------------
+ src/Language/Grammars/Grammar/AG.hs view
@@ -0,0 +1,23 @@+module Language.Grammars.Grammar.AG where++import Language.Grammars.Grammar+import Control.Applicative+++------------------------+-- IDIOMS FOR AG+++instance Idiomatic l env f g => Idiomatic l env (a -> f) (Symbol a TAttT env -> g) where+-- idiomatic isf is = idiomatic (isf <*> ((\x -> x) <$> (sym is :: PreProductions l env a)))+ idiomatic isf is = idiomatic (isf <*> (sym is :: PreProductions l env a))++instance Idiomatic l env f g => Idiomatic l env (DTerm String -> f) (Kw -> g) where+-- idiomatic isf (Kw is) = idiomatic (isf <*> ((\x -> x) <$> (tr is)))+ idiomatic isf (Kw is) = idiomatic (isf <*> (tr is))++newtype SF a = SF { unSF :: a }++instance Idiomatic l env f g => Idiomatic l env (a -> f) (SF a -> g) where+ idiomatic isf (SF f) = idiomatic (isf <*> (pure f :: PreProductions l env a))+
+ src/Language/Grammars/Grammar/AspectAG.hs view
@@ -0,0 +1,21 @@++module Language.Grammars.Grammar.AspectAG where++import Language.Grammars.Grammar+import Data.HList+import Control.Applicative+++------------------------+-- IDIOMS FOR AspectAG+++instance Idiomatic l env f g => Idiomatic l env ((Record HNil -> a) -> f) (Symbol a TAttT env -> g) where+ idiomatic isf is = idiomatic (isf <*> ((\x (Record HNil) -> x) <$> (sym is :: PreProductions l env a)))+++instance Idiomatic l env f g => Idiomatic l env ((Record HNil -> DTerm String) -> f) (Kw -> g) where+ idiomatic isf (Kw is) = idiomatic (isf <*> ((\x (Record HNil) -> x) <$> (tr is)))+++
src/Language/Grammars/Murder.hs view
@@ -100,6 +100,14 @@ -- extensible record +newtype LSPair nt a t env = LSPair { symLSPair :: (Symbol a t env) } ++labelLSPair :: LSPair nt a t env -> nt+labelLSPair _ = undefined++infixr 6 ^= +(^=) :: nt -> Symbol a t env -> LSPair nt a t env+(^=) _ = LSPair data NTCons nt v l env = NTCons (LSPair nt v TNonT env) (l env) data NTNil env = NTNil