{-# LANGUAGE DeriveAnyClass, DeriveGeneric, TypeFamilies, QuasiQuotes
, DataKinds, ScopedTypeVariables, OverloadedStrings, TypeSynonymInstances
, FlexibleInstances, UndecidableInstances, DeriveDataTypeable
, TemplateHaskell #-}
module Language.ANTLR4.Parser (g4) where
import Control.Arrow ( (&&&) )
import Data.Char (isUpper)
import Text.ANTLR.Common
import Text.ANTLR.Grammar
import Text.ANTLR.Parser
import qualified Text.ANTLR.LR as LR
import Text.ANTLR.Lex.Tokenizer as T hiding (tokenize)
import qualified Text.ANTLR.Set as S
import Text.ANTLR.Set (Hashable(..), Generic(..))
import Text.ANTLR.Pretty
import Text.ANTLR.Lex.Regex (regex2dfa)
import Data.Data (Data(..))
import Language.Haskell.TH.Lift (Lift(..))
import Language.Haskell.TH.Quote (QuasiQuoter(..))
import qualified Language.Haskell.TH as TH
import Language.ANTLR4.Boot.Quote (antlr4, g4_parsers)
import Language.ANTLR4.Syntax
import qualified Language.ANTLR4.Boot.Syntax as G4S
import qualified Language.ANTLR4.Boot.Quote as G4Q
import Language.ANTLR4.G4
import Debug.Trace as D
$(g4_parsers g4AST g4Grammar)
isWhitespace T_LineComment = True
isWhitespace T_WS = True
isWhitespace _ = False
g4_codeGen :: String -> TH.Q [TH.Dec]
g4_codeGen input = do
loc <- TH.location
let fileName = TH.loc_filename loc
let (line,column) = TH.loc_start loc
case glrParse isWhitespace input of
(LR.ResultAccept ast) -> codeGen ast
LR.ResultSet s ->
if S.size s == 1
then codeGen $ fromAccept (S.findMin s)
else D.trace (pshow' s) $ codeGen $ fromAccept (S.findMin s)
err -> error $ pshow' err
fromAccept (LR.ResultAccept ast) = ast
fromAccept err = error $ pshow' err
codeGen ast = G4Q.g4_decls $ ast2decls ast
g4 :: QuasiQuoter
g4 = QuasiQuoter
(error "parse exp")
(error "parse pattern")
(error "parse type")
g4_codeGen