murder 1.3.2 → 1.3.3

raw patch · 9 files changed

+113/−54 lines, 9 files

Files

• murder.cabal +1/−1
• src/Language/Grammars/Grammar.hs +90/−52
• src/Language/Grammars/Grammar/AspectAG.hs +1/−0
• src/Language/Grammars/Murder/UULib.hs +1/−1
• src/Language/Grammars/Murder/UUParsing.hs +7/−0
• src/Language/Grammars/Transformations/GramTrafo.hs +2/−0
• src/Language/Grammars/Transformations/LeftCorner.hs +6/−0
• src/Language/Grammars/Transformations/RemoveEmpties.hs +2/−0
• src/Language/Grammars/Transformations/RemoveFix.hs +3/−0

@@ -1,5 +1,5 @@ name:               murder -version:            1.3.2+version:            1.3.3 cabal-version:      >= 1.2.3   license:            LGPL license-file:       COPYRIGHT

@@ -13,19 +13,29 @@ -- GRAMMAR REPRESENTATION ------------------------------------------- -data TL-data FL a-data NF - data Grammar a     = forall env . Grammar  (Ref a env)                             (FinalEnv (Productions NF) env)  -newtype Productions l a env -  = PS {unPS :: [Prod l a env]}+type GramEnv     = Env (Productions NF)+type PreGramEnv  = Env (Productions TL) +++------------------------+-- Productions+------------------------++-- Labels for a production+data TL   -- toplevel production+data FL a -- fixpoint level production+data NF   -- no fixpoint production++++-- The datatype to represent an applicative style production data Prod l a env where       Star      ::  Prod l (a->b) env -> Prod l  a      env                  ->  Prod l b  env@@ -36,46 +46,32 @@       Pure      ::  a                                                       ->  Prod l a  env +      -- internally used for recursion in productions       Fix       ::  Productions (FL a) a env                                ->  Prod TL     a  env       Var       ::  Prod (FL a) a  env  --- I tried with HOAS, but it is more restrictive---      Fix       ::  (forall s. Prod a s -> Productions a s)  -> Prod a env   -type GramEnv = Env (Productions NF)-type PreGramEnv = Env (Productions TL)-+newtype Productions l a env +  = PS {unPS :: [Prod l a env]}  newtype PreProductions l env a    = PP {unPP :: [Prod l a env]} +--------------------------+-- Symbols+-------------------------- -type Line      = Int-type Column    = Int-type Filename  = String -data Pos  =  Pos      !Line !Column -          |  PosFile  !Line !Column Filename-  deriving (Eq)+-- Labels for a symbol+data TTerm -- Terminal+data TNonT -- Non terminal+data TAttT -- Attributed terminal -instance Show Pos where- show (Pos (-1) (-1)) = "Built-in"- show (Pos l    c)    = "Line: " ++ show l ++ " Column: " ++ show c- show (PosFile (-1) (-1) _)  = "Built-in"- show (PosFile l    c    f)  = "Line: " ++ show l ++ " Column: " ++ show c ++ " File: " ++ f- -data DTerm a = DTerm {pos :: Pos, value :: a}-  deriving (Show, Eq) -mkDTerm :: a -> DTerm a-mkDTerm v = DTerm (Pos 0 0) v--data TTerm-data TNonT-data TAttT-+-- | Represents a symbol in a production, either a terminal or non terminal. +--  Additional attributed terminal symbols exist for common lexical structures. data Symbol a t env where   Term    :: String    ->  Symbol  (DTerm String)    TTerm   env @@ -86,48 +82,83 @@   TermVarid ::             Symbol  (DTerm String)    TAttT   env   TermConid ::             Symbol  (DTerm String)    TAttT   env   TermOp    ::             Symbol  (DTerm String)    TAttT   env -  --- TODO: the rest of EnumValToken+  TermAnyOf     :: [Char] ->     Symbol  (DTerm Char)      TAttT   env+  TermAnyExcept :: [Char] ->     Symbol  (DTerm Char)      TAttT   env  +-- | Gets the reference into the environment from the non terminal.   getRefNT :: Symbol a TNonT env -> Ref a env getRefNT (Nont ref) = ref  -pairEq :: Maybe (Equal a b) -> Maybe (Equal (a,t) (b,t))-pairEq (Just Eq) = Just Eq-pairEq Nothing   = Nothing +-- | Matches two symbols matchSym  ::  Symbol a t1 env -> Symbol b t2 env            ->  Maybe (Equal (a,t1) (b,t2))-matchSym (Nont x)   (Nont y)             = pairEq $ match x y-matchSym (Term x)   (Term y) | x == y    = Just Eq-matchSym TermInt    TermInt              = Just Eq-matchSym TermVarid  TermVarid            = Just Eq-matchSym TermConid  TermConid            = Just Eq-matchSym TermOp     TermOp               = Just Eq-matchSym _          _                    = Nothing+matchSym (Nont x)           (Nont y)                        = pairEq $ match x y+matchSym (Term x)           (Term y)            | x == y    = Just Eq+matchSym TermInt            TermInt                         = Just Eq+matchSym TermVarid          TermVarid                       = Just Eq+matchSym TermConid          TermConid                       = Just Eq+matchSym TermOp             TermOp                          = Just Eq+matchSym (TermAnyOf cs)     (TermAnyOf cs')     | cs == cs' = Just Eq+matchSym (TermAnyExcept cs) (TermAnyExcept cs') | cs == cs' = Just Eq+matchSym _          _                                       = Nothing +pairEq :: Maybe (Equal a b) -> Maybe (Equal (a,t) (b,t))+pairEq (Just Eq) = Just Eq+pairEq Nothing   = Nothing ++-- Smart constructors for symbols int   ::  Symbol (DTerm Int)     TAttT  env char  ::  Symbol (DTerm Char)    TAttT  env-var   ::  Symbol (DTerm String)  TAttT  env-con   ::  Symbol (DTerm String)  TAttT  env-op    ::  Symbol (DTerm String)  TAttT  env+var, con, op     ::  Symbol (DTerm String)  TAttT  env+anyOf, anyExcept :: [Char] -> Symbol (DTerm Char) TAttT env -int   =  TermInt-char  =  TermChar-var   =  TermVarid-con   =  TermConid-op    =  TermOp+int       = TermInt+char      = TermChar+var       = TermVarid+con       = TermConid+op        = TermOp+anyOf     = TermAnyOf+anyExcept = TermAnyExcept  +-------------------------+-- DTerm+-------------------------+++type Line      = Int+type Column    = Int+type Filename  = String++data Pos  =  Pos      !Line !Column +          |  PosFile  !Line !Column Filename+  deriving (Eq)++instance Show Pos where+ show (Pos (-1) (-1)) = "Built-in"+ show (Pos l    c)    = "Line: " ++ show l ++ " Column: " ++ show c+ show (PosFile (-1) (-1) _)  = "Built-in"+ show (PosFile l    c    f)  = "Line: " ++ show l ++ " Column: " ++ show c ++ " File: " ++ f+ +data DTerm a = DTerm {pos :: Pos, value :: a}+  deriving (Show, Eq)++mkDTerm :: a -> DTerm a+mkDTerm v = DTerm (Pos 0 0) v++ ------------------------ -- APPLICATIVE INTERFACE -+-- | Lifts a single symbol into a singleton PreProductions sym  ::  Symbol a  t  env -> PreProductions l env a sym  s = PP [ Sym $ s ] +-- | Lifts a non terminal into a singleton PreProductions nt :: Symbol a  TNonT  env -> PreProductions l env a nt s = sym s @@ -135,15 +166,21 @@ ntPrd s =  id <$> nt s   +-- | Lifts a string, as terminal into a singleton PreProductions tr ::  String -> PreProductions l env (DTerm String) tr s = PP [ Sym $ Term s ]  +-- | Conversion between Productions and PreProductions prod :: PreProductions l env a -> Productions l a env prod (PP ps) = PS ps +-- | A PreProductions for a variable used on fixpoint level varPrd   ::  PreProductions (FL a) env a varPrd    = PP [ Var ]+++-- | The fixpoint of a production fixPrd  ::  PreProductions (FL a) env a -> PreProductions TL env a fixPrd p  = PP [ (Fix . prod) p ] @@ -217,6 +254,7 @@ pFoldr (c, e) p = fixPrd (none <|> more)      where  none = pure e              more = c   <$> p <*> varPrd+  ------------------------ -- IDIOMS

@@ -14,6 +14,7 @@     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))) 

@@ -53,7 +53,7 @@          comp (Sym TermVarid)  = pVar          comp (Sym TermConid)  = pCon          comp (Sym TermOp)     = pOp-+--TODO: add the new attributed non-terminals  mapEnv  ::  (forall a . f a s -> g a s)           ->  Env f s env -> Env g s env

@@ -41,6 +41,10 @@ pTerm :: String -> Parser String pTerm keyw = pToken keyw `micro` 1 <* pSpaces ++pAnyExcept :: [Char] -> Parser Char+pAnyExcept cs = pSatisfy (`notElem` cs) (Insertion "" 'a' 5)+ pSpaces' :: Parser String pSpaces' = (:) <$> pAnySym " \r\n\t" <*> pSpaces @@ -77,6 +81,9 @@          comp (Sym TermVarid)  = (DTerm . lc2Pos) <$> pPos <*> (pVar kws)  <?> "identifier"          comp (Sym TermConid)  = (DTerm . lc2Pos) <$> pPos <*> (pCon kws)  <?> "constructor"          comp (Sym TermOp)     = (DTerm . lc2Pos) <$> pPos <*> pOp         <?> "operator"++         comp (Sym (TermAnyOf     x)) = (DTerm . lc2Pos) <$> pPos <*> pAnySym x      <?> "any of: " ++ x+         comp (Sym (TermAnyExcept x)) = (DTerm . lc2Pos) <$> pPos <*> pAnyExcept x   <?> "any except: " ++ x   mapEnv  ::  (forall a . f a s -> g a s)  

@@ -67,6 +67,8 @@ mapProd _ (Sym TermVarid)     = Sym TermVarid  mapProd _ (Sym TermConid)     = Sym TermConid  mapProd _ (Sym TermOp)        = Sym TermOp +mapProd _ (Sym (TermAnyOf     x)) = Sym (TermAnyOf x)+mapProd _ (Sym (TermAnyExcept x)) = Sym (TermAnyExcept x) mapProd _ (Pure x)            = Pure x mapProd t (Star r l)          = Star     (mapProd t r) (mapProd t l) mapProd t (FlipStar r l)      = FlipStar (mapProd t r) (mapProd t l)

@@ -143,6 +143,12 @@ rule2F _    TermOp       = proc (_, a_x) ->         do  returnA -< PS [rule2a'F TermOp a_x]+rule2F _    (TermAnyOf x)+     = proc (_, a_x) ->+        do  returnA -< PS [rule2a'F (TermAnyOf x) a_x]+rule2F _    (TermAnyExcept x)+     = proc (_, a_x) ->+        do  returnA -< PS [rule2a'F (TermAnyExcept x) a_x]   rule2a'F :: Symbol a t s -> Ref (a->b) s -> Prod NF b s

@@ -70,6 +70,8 @@ isEmpty (Sym (TermVarid))     _       = HasNotEmpty isEmpty (Sym (TermConid))     _       = HasNotEmpty isEmpty (Sym (TermOp))        _       = HasNotEmpty+isEmpty (Sym (TermAnyOf _))   _       = HasNotEmpty+isEmpty (Sym (TermAnyExcept _)) _     = HasNotEmpty isEmpty (Sym (Nont r))        empties = lookupEnv r empties isEmpty (Star pl pr)          empties = case isEmpty pl empties of                                          HasEmpty (Pure f)  -> case isEmpty pr empties of

@@ -77,6 +77,9 @@ mapSym _ TermVarid     = TermVarid  mapSym _ TermConid     = TermConid  mapSym _ TermOp        = TermOp +mapSym _ (TermAnyOf     x) = TermAnyOf x+mapSym _ (TermAnyExcept x) = TermAnyExcept x+  remVar  :: Ref b s -> T env s -> Prod (FL b) a env -> Prod NF a s remVar _  t  (Sym s)             = Sym $ mapSym t s