Parser.hs

{-# LANGUAGE DeriveAnyClass, DeriveGeneric, TypeFamilies, QuasiQuotes
    , DataKinds, ScopedTypeVariables, OverloadedStrings, TypeSynonymInstances
    , FlexibleInstances, UndecidableInstances, DeriveDataTypeable
    , TemplateHaskell #-}
{-|
  Module      : Language.ANTLR4.Parser
  Description : Core G4 quasiquoter (with parsers) for antlr-haskell
  Copyright   : (c) Karl Cronburg, 2019
  License     : BSD3
  Maintainer  : karl@cs.tufts.edu
  Stability   : experimental
  Portability : POSIX

-}
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

-- Splice the parsers for the grammar we defined in Language.ANTLR4.G4
$(g4_parsers g4AST g4Grammar)

{- isWhitespace (Just T_LineComment) = True
isWhitespace (Just T_WS) = True
isWhitespace Nothing = True
isWhitespace _ = False -}

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 allstarParse (filter (not . isWhitespace . stripEOF . getSymbol) (tokenize input)) of
    Left err -> error err
    Right ast -> codeGen ast -}
  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

-- | Entrypoint to the G4 quasiquoter. Currently only supports declaration-level
--   Haskell generation of G4 grammars using a GLR parser. The output grammars
--   need not use a GLR parser themselves.
g4 :: QuasiQuoter
g4 = QuasiQuoter
  (error "parse exp")
  (error "parse pattern")
  (error "parse type")
  g4_codeGen