BNFC-meta 0.3.0.5 → 0.6.1
raw patch · 17 files changed
Files
- BNFC-meta.cabal +39/−19
- Bootstrap/Bootstrap.hs +4/−1
- Language/Haskell/TH/Hide.hs +2/−1
- Language/LBNF.hs +26/−5
- Language/LBNF/CFtoAbstract.hs +21/−12
- Language/LBNF/CFtoHappy.hs +5/−28
- Language/LBNF/CFtoLayout.hs +28/−113
- Language/LBNF/Compiletime.hs +11/−3
- Language/LBNF/Runtime.hs +20/−11
- examples/ghc6/jll/JavaletteLight.hs +0/−59
- examples/ghc6/jll/UseJll.hs +0/−46
- examples/ghc7/jll/JavaletteLight.hs +0/−60
- examples/ghc7/jll/UseJll.hs +0/−46
- examples/jll/JavaletteLight.hs +44/−0
- examples/jll/UseJll.hs +29/−0
- examples/typesafe/Example.hs +46/−0
- examples/typesafe/Typesafe.hs +79/−0
BNFC-meta.cabal view
@@ -1,36 +1,56 @@-Name: BNFC-meta-version: 0.3.0.5+Name: BNFC-meta+version: 0.6.1 cabal-Version: >= 1.6 build-type: Simple license: GPL-2 license-file: LICENSE-author: Jonas Duregård-maintainer: Jonas Duregård (jonas.duregard@chalmers.se)-category: Development-synopsis: Deriving Quasi-Quoters from BNF Grammars-description: This package provides a comfortable way of defining quasi-quoters. +author: Jonas Duregård+maintainer: Artem Pelenitsyn <artem.pelenitsyn@gmail.com>+category: Development, parsing, text, language+synopsis: Deriving Parsers and Quasi-Quoters from BNF Grammars+description: This package provides a very simple way of defining a compiler + front-end for a language by embedding a BNF grammar directly into a Haskell + source file. + Specifically, given a quasi-quoted LBNF grammar (as used by the BNF Converter) - it generates (using Template Haskell) an LALR parser and pretty pretty printer - for the language. The parser is then used to define a quasi-quoter. With a simple- pragma, the user can define a universal syntax for anti-quoting. This means that - any grammar non-terminal can be replaced by a quoted Haskell expression of the - appropriate type. A few examples are included in the source tarball.+ it generates (using Template Haskell) a LALR parser and pretty pretty printer + for the language. The parser is then used to automatically define a + quasi-quoter for the defined language so it can also be seamlessly embedded+ in Haskell source code. With a + simple addition to the gramwmar, the user can define a universal syntax for + anti-quoting. This + means that any grammar non-terminal can be replaced by a quoted Haskell + expression of the appropriate type. A few example languages are included in+ the source tarball.+ . + The LBNF grammar formalism is described thoroughly in the BNF Converter + documentation: <http://bnfc.digitalgrammars.com/>+ . + This library and the additions it makes to LBNF is described in a + 2011 Haskell Symposium paper titled \"Embedded Parser Generators\":+ <http://wiki.portal.chalmers.se/cse/pmwiki.php/FP/EmbeddedParserGenerators> extra-source-files:- examples/ghc7/jll/JavaletteLight.hs- examples/ghc7/jll/UseJll.hs- examples/ghc6/jll/JavaletteLight.hs- examples/ghc6/jll/UseJll.hs+ examples/jll/JavaletteLight.hs+ examples/jll/UseJll.hs+ examples/typesafe/Example.hs+ examples/typesafe/Typesafe.hs Bootstrap/Bootstrap.hs +source-repository head+ type: git+ location: https://github.com/ulysses4ever/BNFC-meta++ Library Build-Depends: base>=4.2&&<5- , array==0.4.*- , template-haskell >=2.4&&<2.9+ , array>=0.4&&<0.6+ , fail >=4.9&&<5+ , template-haskell >=2.12 && < 2.16 , haskell-src-meta >= 0.5 && < 1.0 , happy-meta >= 0.2.0.4 && < 0.3- , alex-meta >= 0.3.0.3 && < 0.4+ , alex-meta >= 0.3.0.5 && < 0.4 , syb >= 0.2 && <1.0 Exposed-modules: Language.LBNF
Bootstrap/Bootstrap.hs view
@@ -25,13 +25,16 @@ import System.FilePath -package = "BNFC-meta-0.2.1"+-- This was required for some reason but I don't recall why /Jonas+package = "BNFC-meta-0.6" nfile = file ++ ".new.bak" file = ".." </> "Language" </> "LBNF" </> "Grammar.hs" bfile = file ++ ".bak" bbfile = bfile ++ ".bak" +-- Running this code will generate a new LBNF quasi-quoter file using +-- an existing installation of BNFC-meta. It's all very meta. main = do c <- getCode ("Language.LBNF.Grammar") g doesFileExist bfile >>= \b -> when b $ copyFile bfile bbfile
Language/Haskell/TH/Hide.hs view
@@ -2,6 +2,7 @@ import Data.List(partition) import Language.Haskell.TH +-- Takes a list of declaration and puts them all in a where-clause, exporting only some of them by pattern-matching on a tuple. export :: [Name] -> [Dec] -> Q [Dec] export el = buildClause el . partition whereable where whereable :: Dec -> Bool@@ -19,7 +20,7 @@ (map return wh) return $ v : tl - +-- GHC has a limit on tuple size... splitTup :: ([a] -> a) -> [a] -> a splitTup tup ls = case splitAt 60 ls of (_,[]) -> tup ls
Language/LBNF.hs view
@@ -1,8 +1,16 @@ {-# OPTIONS_GHC -fno-warn-missing-fields #-}++-- | Contains the main language definition routines of BNFC-meta. module Language.LBNF (- lbnf -- QuasiQuoter for LBNF- , bnfc -- Parser meta-generator function- , dumpAlex, dumpHappy, dumpHappyM, dumpCode, getCode -- Debug / code generation+ -- * Main language definition routines+ lbnf + , bnfc+ -- * Debugging functions+ , dumpCode+ , getCode+ , dumpAlex + , dumpHappy+-- , dumpHappyM , module Language.LBNF.Compiletime -- , module Language.LBNF.Grammar ) where@@ -26,10 +34,16 @@ import Data.List(isPrefixOf, intersperse) -+-- | QuasiQuoter for LBNF. Usage: @[lbnf| \<grammar for your language\>|]@+-- +-- The spliced code is an expression of type 'Grammar'. lbnf :: QuasiQuoter lbnf = grammar +-- | Typical usage (as a top level declaration): @bnfc [lbnf|\<grammar\>|]@+-- +-- The spliced code contains a parser, a pretty-printer and a Quasi-Quoter for +-- the language defined by the grammar. bnfc :: Grammar -> Q [Dec] bnfc = compile . toCF @@ -72,7 +86,8 @@ (filter isNormal (allCats cf)) ++ if hasIdent cf then ["Ident(..)"] else [] -+-- | Equivalent to 'bnfc' with the side-effect of dumping the parser +-- definition into a file named "dump.y" dumpHappy :: Grammar -> Q [Dec] dumpHappy g = location >>= \l -> dumpHappyM g (loc_module l, loc_package l) >> bnfc g @@ -82,17 +97,23 @@ runIO $ writeFile "dump.y" $ cf2Happy (Loc {loc_module = m, loc_package = p}) cf -- compile cf +-- | Equivalent to 'bnfc' with the side-effect of dumping the lexer +-- definition into a file named dump.x dumpAlex :: Grammar -> Q [Dec] dumpAlex g = do let cf = toCF g runIO $ writeFile "dump.x" $ cf2alex2 cf compile cf +-- | Equivalent to 'bnfc' with the side-effect of dumping ALL the spliced code +-- into a file named dump.hs dumpCode :: Grammar -> Q [Dec] dumpCode g = do runIO $ getCode ("Main") g >>= writeFile "dump.hs" bnfc g +-- | Computes the Haskell source code that would be spliced by a grammar and +-- wraps it into a compilable Haskell module. getCode :: String -> Grammar -> IO String getCode m g = do let cf = toCF g
Language/LBNF/CFtoAbstract.hs view
@@ -24,37 +24,46 @@ import Language.LBNF.CF -absRules :: CF -> Q [Dec]-absRules cf0 = sequence $ - map (prData $ map mkName $ derivations cf0) $ cf2data cf0 +absRules :: CF -> Q [Dec]+absRules cf0 = sequence $ + map (prData $ mkDerivClause $ map mkName $ derivations cf0) $ cf2data cf0+ where+ mkDerivClause :: [Name] -> [Q DerivClause]+ mkDerivClause names = return $ return $ DerivClause Nothing (map ConT names) absTokens :: CF -> Q [Dec] absTokens cf0 = sequence $ - map (prSpecialData (map mkName $ derivations cf0) cf0) (specialCats cf0)-+ map (prSpecialData (mkDerivClause $ map mkName $ derivations cf0) cf0) (specialCats cf0)+ where+ mkDerivClause :: [Name] -> [DerivClause]+ mkDerivClause names = return $ DerivClause Nothing (map ConT names) fixname :: String -> TypeQ fixname ('[':xs) = appT listT $ conT $ mkName $ init xs fixname xs = conT $ mkName xs -prData :: [Name] -> Data -> Q Dec+prData :: [DerivClauseQ] -> Data -> Q Dec prData deriv (cat,rules) = - dataD (return []) (mkName cat) [] (map cons rules) deriv where+ dataD (return []) (mkName cat) [] Nothing (map cons rules) deriv where cons (fun,cats) = normalC (mkName fun) $ either (map typ) (const str) cats typ = strictType notStrict . fixname str = [typ "String"] -- deriv = [''Eq,''Ord,''Show] -prSpecialData :: [Name] -> CF -> Cat -> Q Dec-prSpecialData deriv cf cat =- newtypeD (return []) (mkName cat) [] con deriv where- con = normalC (mkName cat) $ [typ]- typ = strictType notStrict $ contentSpec cf cat+prSpecialData :: [DerivClause] -> CF -> Cat -> Q Dec+prSpecialData deriv cf cat = do+ let con = normalC (mkName cat) $ [typ]+ typ = strictType notStrict $ contentSpec cf cat+ ctxt1 <- (return [])+ con1 <- con+ return (NewtypeD ctxt1 (mkName cat) [] Nothing con1 deriv) +-- got rid of newtypeD by replacing it with its definition in 2.10.0.0, and then+-- forcing the parameters of NewtypeD to match up with the new types in 2.12.0.0 contentSpec :: CF -> Cat -> Q Type
Language/LBNF/CFtoHappy.hs view
@@ -109,8 +109,6 @@ prTokens tk oneTok t k = "PT _ (TS _ " ++ show k ++ ")" --- Happy doesn't allow characters such as åäö to occur in the happy file. This--- is however not a restriction, just a naming paradigm in the happy source file. convert :: String -> String convert "\\" = concat ['\'':"\\\\","\'"] convert xs = concat ['\'':(escape xs),"\'"]@@ -122,11 +120,7 @@ rulesForHappy cf = map mkOne $ ruleGroups cf where mkOne (cat,rules) = constructRule cf rules cat --- For every non-terminal, we construct a set of rules. A rule is a sequence of--- terminals and non-terminals, and an action to be performed--- As an optimization, a pair of list rules [C] ::= "" | C k [C]--- is left-recursivized into [C] ::= "" | [C] C k.--- This could be generalized to cover other forms of list rules.+ constructRule :: CF -> [Rule] -> NonTerminal -> (NonTerminal,[(Rule,Pattern,Action)]) constructRule cf rules nt = (nt,[(r,p,generateAction nt (revF b r) m) | r0 <- rules,@@ -140,9 +134,7 @@ underscore f | isDefinedRule f = f ++ "_" | otherwise = f --- Generates a string containing the semantic action.--- An action can for example be: Sum $1 $2, that is, construct an AST--- with the constructor Sum applied to the two metavariables $1 and $2.+ generateAction :: NonTerminal -> (Fun) -> [(Bool,Cat,MetaVar)] -> Action generateAction nt f ms = MkAction (if isCoercion f then Nothing else Just f) ms @@ -221,7 +213,7 @@ prActionQ rulz (MkAction fun ms) = maybe (thrd $ head ms) pf fun where thrd (_,_,m) = m pf f - | isAqFun f = fun ++ " " ++ unwords (map (\(b,c,m) -> m) ms)+ | isAqFun f = fun ++ " " ++ unwords (map (\(b,c,m) -> if b then "(reverse "++m++")" else m) ms) | isTokenRule rulz = fromToken ++ "\""++f++"\" $1" | otherwise = constr++" ["++ (concat $ intersperse "," [m1|(_,c,m1) <- ms])@@ -237,14 +229,8 @@ "(:[])" -> appEPAllL _ -> appEPAll ++"\""++f++"\" " - {-- expspats - | isTokenRule rul = fromToken ++ "\""++f++"\" $1"- | otherwise = constr++" ["++- (concat $ intersperse "," [m1|(_,c,m1) <- ms])- ++ "]" --}+ isAqAction (MkAction mf _) = maybe False isAqFun mf prPattern = prPatternQ True@@ -282,10 +268,7 @@ | otherwise = App x $ map underscore es underscore e = e --- aarne's modifs 8/1/2002:--- Markus's modifs 11/02/2002 --- GF literals specialToks :: CF -> String specialToks cf = unlines $ (map aux (literals cf))@@ -308,13 +291,7 @@ -- m = loc_module l aux (fun,cat) = case cat of--- "Ident" -> "Ident :: { (Ident } : L_ident { (Ident $1,fromToken \"Ident\" $1) }" --- "String" -> "String :: { (String,BNFC_QQType) } : L_quoted { fromString $1 }" -- FIXME: Why not read?--- "Integer" -> "Integer :: { (Integer,BNFC_QQType) } \nInteger : "++iaq++"L_integ { fromLit (read $1) }"--- "Double" -> "Double :: { (Double,BNFC_QQType) } : L_doubl { fromLit (read $1) }"--- "Char" -> "Char :: { (Char,BNFC_QQType) } : L_charac { fromLit (read $1) }"--- own -> own ++ " :: { (" ++ own ++ ",BNFC_QQType) } : L_" ++ own ++ --- " { (" ++ own ++ " ("++ posn ++ "$1),fromToken \""++own++"\" $1)}"+ "Ident" -> unlines [ "Ident :: { Ident } : L_ident { Ident $1 }" , "QQ_Ident :: { BNFC_QQType } : L_ident { "++fromToken ++"\"Ident\" $1 }"
Language/LBNF/CFtoLayout.hs view
@@ -67,63 +67,43 @@ (id [''Token, 'Err, ''Posn, 'PT, ''Tok, 'TS, 'Pn, ''Block, 'Implicit, 'Explicit]) (map mkName ["Token", "Err", "Posn", "PT", "Tok", "TS", "Pn", "Block", "Implicit","Explicit"]) in fmap mkRename $ - fmap (DataD [] (mkName "Block") [] [NormalC (mkName "Implicit") [(NotStrict,ConT ''Int)],- NormalC (mkName "Explicit") []] [''Show]:)- (makedecs top lay stop cf) + fmap (DataD [] (mkName "Block") [] Nothing [NormalC (mkName "Implicit") [(Bang NoSourceUnpackedness NoSourceStrictness ,ConT ''Int)],+ NormalC (mkName "Explicit") []]+ ([DerivClause Nothing [ConT ''Show]]) :)+ (makedecs top lay stop (sort (reservedWords cf ++ symbols cf)))+ +-- Hack to make haddock work+makedecs :: Bool -> [String] -> [String] -> [String] -> Q [Dec]+makedecs top lay stop resws = [d| --- | makedecs -makedecs :: Bool -> [String] -> [String] -> CF -> Q [Dec]-makedecs top lay stop cf = [d| topLayout = $(lift top) layoutWords = $(lift lay) layoutStopWords = $(lift stop) - -- layout separators- layoutOpen = $(lift layoutOpen') layoutClose = $(lift layoutClose') layoutSep = $(lift layoutSep') - -- | Replace layout syntax with explicit layout tokens.- --resolveLayout :: Bool -- ^ Whether to use top-level layout.- -- -> [Token] -> [Token]+ resolveLayout tp = res Nothing [if tl then Implicit 1 else Explicit] where- -- Do top-level layout if the function parameter and the grammar say so. tl = tp && topLayout- - --res :: Maybe Token -- ^ The previous token, if any.- -- -> [Block] -- ^ A stack of layout blocks.- -- -> [Token] -> [Token]- - -- The stack should never be empty. res _ [] ts = error $ "Layout error: stack empty. Tokens: " ++ show ts res _ st (t0:ts)- -- We found an open brace in the input,- -- put an explicit layout block on the stack.- -- This is done even if there was no layout word,- -- to keep opening and closing braces. | isLayoutOpen t0 = moveAlong (Explicit:st) [t0] ts res _ st (t0:ts)- -- Start a new layout block if the first token is a layout word | isLayout t0 = case ts of- -- Explicit layout, just move on. The case above- -- will push an explicit layout block. t1:_ | isLayoutOpen t1 -> moveAlong st [t0] ts- -- at end of file, the start column doesn't matter _ -> let col = if null ts then column t0 else column (head ts)- -- insert an open brace after the layout word b:ts' = addToken (nextPos t0) layoutOpen ts- -- save the start column st' = Implicit col:st in moveAlong st' [t0,b] ts' - -- If we encounter a closing brace, exit the first explicit layout block. | isLayoutClose t0 = let st' = drop 1 (dropWhile isImplicit st) in if null st' @@ -132,35 +112,22 @@ ++ ") without an explicit layout block." else moveAlong st' [t0] ts - -- We are in an implicit layout block res pt st@(Implicit n:ns) (t0:ts) - -- End of implicit block by a layout stop word | isStop t0 = - -- Exit the current block and all implicit blocks - -- more indented than the current token let (ebs,ns') = span (`moreIndent` column t0) ns moreIndent (Implicit x) y = x > y moreIndent Explicit _ = False- -- the number of blocks exited b = 1 + length ebs bs = replicate b layoutClose- -- Insert closing braces after the previous token. (ts1,ts2) = splitAt (1+b) $ addTokens (afterPrev pt) bs (t0:ts) in moveAlong ns' ts1 ts2 - -- End of an implicit layout block | newLine && column t0 < n = - -- Insert a closing brace after the previous token. let b:t0':ts' = addToken (afterPrev pt) layoutClose (t0:ts)- -- Repeat, with the current block removed from the stack in moveAlong ns [b] (t0':ts') - -- Encounted a new line in an implicit layout block. | newLine && column t0 == n = - -- Insert a semicolon after the previous token.- -- unless we are the beginning of the file,- -- or the previous token is a semicolon or open brace. if isNothing pt || isTokenIn [layoutSep,layoutOpen] (fromJust pt) then moveAlong st [t0] ts else let b:t0':ts' = addToken (afterPrev pt) layoutSep (t0:ts)@@ -169,135 +136,83 @@ Nothing -> True Just t -> line t /= line t0 - -- Nothing to see here, move along. res _ st (t:ts) = moveAlong st [t] ts - -- At EOF: skip explicit blocks. res (Just t) (Explicit:bs) [] | null bs = [] | otherwise = res (Just t) bs [] - -- If we are using top-level layout, insert a semicolon after- -- the last token, if there isn't one already res (Just t) [Implicit n] [] | isTokenIn [layoutSep] t = [] | otherwise = addToken (nextPos t) layoutSep [] - -- At EOF in an implicit, non-top-level block: close the block res (Just t) (Implicit n:bs) [] = let c = addToken (nextPos t) layoutClose [] in moveAlong bs c [] - -- This should only happen if the input is empty. res Nothing st [] = [] - -- | Move on to the next token.- --moveAlong :: [Block] -- ^ The layout stack.- -- -> [Token] -- ^ Any tokens just processed.- -- -> [Token] -- ^ the rest of the tokens.- -- -> [Token] moveAlong st [] ts = error $ "Layout error: moveAlong got [] as old tokens" moveAlong st ot ts = ot ++ res (Just $ last ot) st ts- + type Position = Posn- - -- | Check if s block is implicit.+ isImplicit :: Block -> Bool isImplicit (Implicit _) = True isImplicit _ = False- - -- | Insert a number of tokens at the begninning of a list of tokens.- addTokens :: Position -- ^ Position of the first new token.- -> [String] -- ^ Token symbols.- -> [Token] -- ^ The rest of the tokens. These will have their- -- positions updated to make room for the new tokens .+ + addTokens :: Position+ -> [String]+ -> [Token] -> [Token] addTokens p ss ts = foldr (addToken p) ts ss- - -- | Insert a new symbol token at the begninning of a list of tokens.- addToken :: Position -- ^ Position of the new token.- -> String -- ^ Symbol in the new token.- -> [Token] -- ^ The rest of the tokens. These will have their- -- positions updated to make room for the new token.", " -> [Token]++ addToken :: Position + -> String + -> [Token]+ -> [Token] addToken p s ts = sToken p s : map (incrGlobal p (length s)) ts- - -- | Get the position immediately to the right of the given token.- -- If no token is given, gets the first position in the file.- -- afterPrev :: Maybe Token -> Position+ afterPrev = maybe (Pn 0 1 1) nextPos - -- | Get the position immediately to the right of the given token.- -- nextPos :: Token -> Position nextPos t = Pn (g + s) l (c + s + 1) where Pn g l c = position t s = tokenLength t - -- | Add to the global and column positions of a token.- -- The column position is only changed if the token is on- -- the same line as the given position.- -- incrGlobal :: Position -- ^ If the token is on the same line- -- -- as this position, update the column position.- -- -> Int -- ^ Number of characters to add to the position.- -- -> Token -> Token incrGlobal (Pn _ l0 _) i (PT (Pn g l c) t) = if l /= l0 then PT (Pn (g + i) l c) t else PT (Pn (g + i) l (c + i)) t incrGlobal _ _ p = error $ "cannot add token at " ++ show p - -- | Create a symbol token.- - reservedwords = $(lift $ zip resws ([1..] :: [Int]))+ + reservedwords = $(resnum) sToken :: Position -> String -> Token sToken p s = PT p (TS s i) where i = maybe (error $ "not a reserved word: " ++ show s) id (lookup s reservedwords)- -- where- -- i = case s of- -- [ " " ++ show s ++ " -> " ++ show i- -- | (s, i) <- - -- ] ++- -- _ -> error $ "not a reserved word: " ++ show s- - -- | Get the position of a token.- -- position :: Token -> Position+ position t = case t of PT p _ -> p Err p -> p - -- | Get the line number of a token.- -- line :: Token -> Int line t = case position t of Pn _ l _ -> l - -- | Get the column number of a token.- -- column :: Token -> Int column t = case position t of Pn _ _ c -> c - -- | Check if a token is one of the given symbols.- -- isTokenIn :: [String] -> Token -> Bool isTokenIn ts t = case t of PT _ (TS r _) | elem r ts -> True _ -> False- - -- | Check if a word is a layout start token.- -- isLayout :: Token -> Bool+ isLayout = isTokenIn layoutWords - -- | Check if a token is a layout stop token.- -- isStop :: Token -> Bool isStop = isTokenIn layoutStopWords - -- | Check if a token is the layout open token.- -- isLayoutOpen :: Token -> Bool isLayoutOpen = isTokenIn [layoutOpen] - -- | Check if a token is the layout close token.- -- isLayoutClose :: Token -> Bool isLayoutClose = isTokenIn [layoutClose] - -- | Get the number of characters in the token.- -- tokenLength :: Token -> Int tokenLength t = length $ $(varE $ mkName "prToken") t+ |]- - where- resws = sort (reservedWords cf ++ symbols cf)+ where resnum = lift $ zip resws ([1..] :: [Int])+
Language/LBNF/Compiletime.hs view
@@ -1,7 +1,10 @@ {-#LANGUAGE TemplateHaskell#-} {-# OPTIONS_GHC -fno-warn-missing-fields #-}+-- | Contains things needed by BNFC-meta language definitions and+-- by the code generated from those. Typical users don't need to browse this +-- module. module Language.LBNF.Compiletime(- -- * Happy and Alex runtimes+ -- * Happy and Alex HappyStk(..) , utf8Encode , Posn(Pn)@@ -11,7 +14,8 @@ , listArray , (!) , Array - -- * Pretty printing runtimes++ -- * Pretty printing , printTree , doc , concatD@@ -19,13 +23,17 @@ , prPrec , PrintPlain(..) - -- * Quasi quoting runtimes+ -- * Quasi quoting , parseToQuoter, parseToMonQuoter , ParseMonad(..) , errq , Q , BNFC_QQType(..), appEPAll, appEPAllL, fromString, fromLit, fromToken, fromPositionToken , Lift (..)+ , LocType+ , Literal(..)+ , IsChar(..)+ -- ** Helper functions for defining Anti-quotation , printAq , stringAq
Language/LBNF/Runtime.hs view
@@ -1,5 +1,6 @@ {-#LANGUAGE TemplateHaskell #-}-+-- | Contains things that are typically needed in modules that use +-- languages defined using BNFC-meta. module Language.LBNF.Runtime( -- * Happy and Alex runtimes -- ord@@ -7,28 +8,26 @@ -- , (!) -- , Array -- , parseToQuoter+ ParseMonad(..) , err -- * Pretty printing runtimes , printTree+ , Doc , doc , concatD , Print(..) , prPrec , PrintPlain(..) - -- * Quasi quoting runtimes- --, Q- --, BNFC_QQType, appEPAll, appEPAllL, fromLit, fromString, fromToken- --, Lift (..) ) where -import Control.Monad (MonadPlus(..), liftM, foldM, (>=>))--+import Control.Monad (MonadPlus(..), liftM, foldM, (>=>), ap)+import Control.Applicative ( Applicative(..) )+import qualified Control.Monad.Fail as Fail import Data.Char @@ -38,23 +37,32 @@ -- Lexing, Parsing ------------------ +-- * The result of a parse. data ParseMonad a = Ok a | Bad String deriving (Read, Show, Eq, Ord) instance Monad ParseMonad where return = Ok- fail = Bad Ok a >>= f = f a Bad s >>= f = Bad s +instance Fail.MonadFail ParseMonad where+ fail = Bad+ instance Functor ParseMonad where fmap = liftM +instance Applicative ParseMonad where+ (<*>) = ap+ pure = return+ --instance MonadPlus ParseMonad where -- mzero = Bad "Err.mzero" -- mplus (Bad _) y = y -- mplus x _ = x +-- * An eliminator for a parse result. Takes a function that recovers from any +-- parse errors. Typical usage: @err error (pCategory (tokens s)) :: Category@ err :: (String -> a) -> ParseMonad a -> a err e b = case b of Bad s -> e s@@ -65,6 +73,7 @@ -- PRINTING ----------- +-- * Overloaded pretty-printer printTree :: Print a => a -> String printTree = render . prt 0 @@ -83,8 +92,8 @@ "}" :ts -> new (i-1) . showChar '}' . new (i-1) . rend (i-1) ts ";" :ts -> showChar ';' . new i . rend i ts t : "," :ts -> showString t . space "," . rend i ts- t : ")" :ts -> showString t . showChar ')' . rend i ts- t : "]" :ts -> showString t . showChar ']' . rend i ts+ t : ")" :ts -> showString t . rend i (")":ts)+ t : "]" :ts -> showString t . rend i ("]":ts) t :ts -> space t . rend i ts _ -> id new i = showChar '\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace
− examples/ghc6/jll/JavaletteLight.hs
@@ -1,59 +0,0 @@-{-# LANGUAGE QuasiQuotes, TemplateHaskell #-}--module JavaletteLight where--import Language.LBNF(lbnf, dumpCode, bnfc)-import Language.LBNF.Compiletime-import qualified Language.LBNF.Grammar----bnfc [$lbnf|---- This is a new pragma. The rest of the grammar is original JL.-antiquote "[" ":" ":]" ;---- Javalette Light: a simple subset of C, covering--- programs with a single zero-argument function.--- example: koe.jll--- ordinary rules--Fun. Prog ::= Typ Ident "(" ")" "{" [Stm] "}" ;--SDecl. Stm ::= Typ Ident ";" ;-SAss. Stm ::= Ident "=" Expr ";" ;-SIncr. Stm ::= Ident "++" ";" ;-SWhile. Stm ::= "while" "(" Expr ")" "{" [Stm] "}" ;--ELt. Expr0 ::= Expr1 "<" Expr1 ;-EPlus. Expr1 ::= Expr1 "+" Expr2 ;-ETimes. Expr2 ::= Expr2 "*" Expr3 ;-EVar. Expr3 ::= Ident ;-EInt. Expr3 ::= Integer ;-EDouble. Expr3 ::= Double ;--[]. [Stm] ::= ;-(:). [Stm] ::= Stm [Stm] ;---- coercions--_. Stm ::= Stm ";" ;--_. Expr ::= Expr0 ;-_. Expr0 ::= Expr1 ;-_. Expr1 ::= Expr2 ;-_. Expr2 ::= Expr3 ;-_. Expr3 ::= "(" Expr ")" ;--TInt. Typ ::= "int" ;-TDouble. Typ ::= "double" ;---- pragmas--comment "/*" "*/" ;-comment "//" ;--entrypoints Prog, Stm, Expr ;- |]--
− examples/ghc6/jll/UseJll.hs
@@ -1,46 +0,0 @@-{-# LANGUAGE QuasiQuotes #-}-import JavaletteLight-import Language.LBNF.Runtime -- overloaded pretty-printing function-import Prelude hiding (exp)--{- This Javalette Light program is parsed at compile time, -and replaced by it's abstract syntax representation.-The 'holes' in square brackets are anti-quoted Haskell -expression. --The QuasiQuoter prog is generated from the grammar in JavaletteLight.hs-(it corresponds to the category Prog).--}---prg x v e = [$prog|-int f() {- int a; - [:SWhile (EInt 10 :: Expr) [x]:]- int a;- int [:v:];- int tmp;- while (n < [Expr:e:]) {- n = n + 1;- tmp = a + b;- a = b;- b = tmp;- }-}-|] --st v = [$stm| [:v:] = 1; |]-pr = prg (st (Ident "n")) (Ident "n") [$expr|n|]-main = putStr $ printTree pr---eval vs = eval' where- eval' [$expr| [:a:] < [:b:] |] = if eval' a < eval' b then 1 else 0- eval' [$expr| [:a:] + [:b:] |] = eval' a + eval' b- eval' [$expr| [:a:] * [:b:] |] = eval' a * eval' b- eval' [$expr| [Integer: n:] |] = fromInteger n- eval' [$expr| [Double: n:] |] = n- eval' [$expr| [Ident: v:] |] = varval v- varval v = maybe (error $ "undefined variable" ++ printTree v) id $ flip lookup vs v--h = eval [(Ident "a",5)] [$expr|a+2+3*4|]
− examples/ghc7/jll/JavaletteLight.hs
@@ -1,60 +0,0 @@-{-# LANGUAGE QuasiQuotes, TemplateHaskell #-}--module JavaletteLight where--import Language.LBNF(lbnf, dumpCode, bnfc)-import Language.LBNF.Compiletime-import qualified Language.LBNF.Grammar-----bnfc [lbnf|---- This is a new pragma. The rest of the grammar is original JL.-antiquote "[" ":" ":]" ;---- Javalette Light: a simple subset of C, covering--- programs with a single zero-argument function.--- example: koe.jll--- ordinary rules--Fun. Prog ::= Typ Ident "(" ")" "{" [Stm] "}" ;--SDecl. Stm ::= Typ Ident ";" ;-SAss. Stm ::= Ident "=" Expr ";" ;-SIncr. Stm ::= Ident "++" ";" ;-SWhile. Stm ::= "while" "(" Expr ")" "{" [Stm] "}" ;--ELt. Expr0 ::= Expr1 "<" Expr1 ;-EPlus. Expr1 ::= Expr1 "+" Expr2 ;-ETimes. Expr2 ::= Expr2 "*" Expr3 ;-EVar. Expr3 ::= Ident ;-EInt. Expr3 ::= Integer ;-EDouble. Expr3 ::= Double ;--[]. [Stm] ::= ;-(:). [Stm] ::= Stm [Stm] ;---- coercions--_. Stm ::= Stm ";" ;--_. Expr ::= Expr0 ;-_. Expr0 ::= Expr1 ;-_. Expr1 ::= Expr2 ;-_. Expr2 ::= Expr3 ;-_. Expr3 ::= "(" Expr ")" ;--TInt. Typ ::= "int" ;-TDouble. Typ ::= "double" ;---- pragmas--comment "/*" "*/" ;-comment "//" ;--entrypoints Prog, Stm, Expr ;- |]--
− examples/ghc7/jll/UseJll.hs
@@ -1,46 +0,0 @@-{-# LANGUAGE QuasiQuotes #-}-import JavaletteLight-import Language.LBNF.Runtime -- overloaded pretty-printing function-import Prelude hiding (exp)--{- This Javalette Light program is parsed at compile time, -and replaced by it's abstract syntax representation.-The 'holes' in square brackets are anti-quoted Haskell -expression. --The QuasiQuoter prog is generated from the grammar in JavaletteLight.hs-(it corresponds to the category Prog).--}---prg x v e = [prog|-int f() {- int a; - [:SWhile (EInt 10 :: Expr) [x]:]- int a;- int [:v:];- int tmp;- while (n < [Expr:e:]) {- n = n + 1;- tmp = a + b;- a = b;- b = tmp;- }-}-|] --st v = [stm| [:v:] = 1; |]-pr = prg (st (Ident "n")) (Ident "n") [expr|n|]-main = putStr $ printTree pr---eval vs = eval' where- varval v = maybe (error $ "undefined variable" ++ printTree v) id $ flip lookup vs v- eval' [expr| [:a:] < [:b:] |] = if eval' a < eval' b then 1 else 0- eval' [expr| [:a:] + [:b:] |] = eval' a + eval' b- eval' [expr| [:a:] * [:b:] |] = eval' a * eval' b- eval' [expr| [Integer: n:] |] = fromInteger n- eval' [expr| [Double: n:] |] = n- eval' [expr| [Ident: v:] |] = varval v--h = eval [(Ident "a",5)] [expr|a+2+3*4|]
+ examples/jll/JavaletteLight.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE QuasiQuotes, TemplateHaskell #-}++module JavaletteLight where++import Language.LBNF.Compiletime++import Language.LBNF(lbnf, dumpCode, bnfc)+bnfc [lbnf|++Fun. Prog ::= Typ Ident "(" ")" "{" [Stm] "}" ;++SDecl. Stm ::= Typ Ident ";" ;+SAss. Stm ::= Ident "=" Expr ";" ;+SIncr. Stm ::= Ident "++" ";" ;+SWhile. Stm ::= "while" "(" Expr ")" "{" [Stm] "}" ;+SFunApp. Stm ::= Ident "(" [Expr] ")" ";" ;+_. Stm ::= Stm ";" ;++ELt. Expr0 ::= Expr1 "<" Expr1 ;+EPlus. Expr1 ::= Expr1 "+" Expr2 ;+ETimes. Expr2 ::= Expr2 "*" Expr3 ;+EVar. Expr3 ::= Ident ;+EInt. Expr3 ::= Integer ;+EDouble. Expr3 ::= Double ;+$. Expr3 ::= "$" Ident;+[]. [Stm] ::= ;+(:). [Stm] ::= Stm [Stm] ;++separator Expr "," ;+++++_. Expr ::= Expr0 ;+_. Expr0 ::= Expr1 ;+_. Expr1 ::= Expr2 ;+_. Expr2 ::= Expr3 ;+_. Expr3 ::= "(" Expr ")" ;++TInt. Typ ::= "int" ;+TDouble. Typ ::= "double" ;+|]++
+ examples/jll/UseJll.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE QuasiQuotes #-}+import JavaletteLight+import Language.LBNF.Runtime -- overloaded pretty-printing function+import Prelude hiding (exp)++{- This Javalette Light program is parsed at compile time, +and replaced by it's abstract syntax representation.+The 'holes' in square brackets are anti-quoted Haskell +expression. ++The QuasiQuoter prog is generated from the grammar in JavaletteLight.hs+(it corresponds to the category Prog).+-}++printing' :: Expr -> Prog+printing' e = [prog| + int main ( ) { + print ( $e ) ; + } + |]++printing e = Fun TInt (Ident "main") [SFunApp (Ident "print") [e]]++print10 :: Prog+print10 = printing' [expr| 5 + 5 |]++main :: IO ()+main = do+ print print10
+ examples/typesafe/Example.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE QuasiQuotes #-}+import Typesafe+import Language.LBNF.Runtime(printTree) -- overloaded pretty-printing function+import Prelude hiding (exp)+++-- All variables are meta-variables. +-- Variables must be declared in the function parameters+-- Boolean and numeric variables are type checked by Haskell.+prg n tmp x = [prog|+f() {+ n = 0;+ x := True ;+ tmp = 0;+ while ( tmp < 10 ) {+ tmp++;+ n = n * n;+ }+}+|]++main = putStr $ printTree $ fresh vars prg where+ vars = (map return ['a'..'z']) ++ ['v' : show n |n <- [0..]]++++class Variable a where+ fromString :: String -> a++instance Variable NVar where+ fromString = NVar . Ident++instance Variable BVar where+ fromString = BVar . Ident+++class Fresh a where+ fresh :: [String] -> a -> Prog+ +instance Fresh Prog where+ fresh _ e = e+ +instance (Variable a, Fresh b) => Fresh (a -> b) where+ fresh (s:ss) g = fresh ss $ g (fromString s)++
+ examples/typesafe/Typesafe.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+++module Typesafe where++import Language.LBNF+ ++bnfc [lbnf|++antiquote "[" ":" ":]" ;++ +Fun. Prog ::= Ident "(" ")" "{" [Stm] "}" ;++SBAss. Stm ::= BVar ":=" BExp ";" ;+SAss. Stm ::= NVar "=" Exp ";" ;++SIncr. Stm ::= NVar "++" ";" ;+SWhile. Stm ::= "while" "(" BExp ")" "{" [Stm] "}" ;+SBlock. Stm ::= "{" [Stm] "}" ;+++ +EAnd. BExp0 ::= BExp "&" BExp1 ;+ENeg. BExp1 ::= "!" BExp1 ;+ELt. BExp1 ::= Exp "<" Exp ;+ETruth. BExp1 ::= Truth ;+EBVar. BExp1 ::= BVar ;++EPlus. Exp0 ::= Exp0 "+" Exp1 ;+ETimes. Exp1 ::= Exp1 "*" Exp2 ;+EInt. Exp2 ::= Integer ;+EVar. Exp2 ::= NVar ;+++TTrue. Truth ::= "True" ;+TFalse. Truth ::= "False" ;++[]. [Stm] ::= ;+(:). [Stm] ::= Stm [Stm] ;++internal BVar. BVar ::= Ident ;+$ . BVar ::= Ident ;++internal NVar. NVar ::= Ident ;+$. NVar ::= Ident ;++++-- coercions++_. Stm ::= Stm ";" ;++_. Exp ::= Exp0 ;+_. Exp0 ::= Exp1 ;+_. Exp1 ::= Exp2 ;+_. Exp2 ::= "[" Exp "]" ;+-- _. Exp2 ::= Exp3 ;+++_. BExp ::= BExp0 ;+_. BExp0 ::= BExp1 ;+_. BExp1 ::= "(" BExp ")" ;++++-- pragmas++comment "/*" "*/" ;+comment "//" ;++entrypoints Prog, Stm, Exp, BExp ;+ |]++ ++