|
-- {-# LANGUAGE BlockArguments #-}
|
|
module Main where
|
|
|
|
import Control.Monad ( unless )
|
|
|
|
import qualified Data.ByteString.Lazy as Lbs
|
|
import qualified Data.Text.Encoding as T
|
|
import qualified Data.Text as T
|
|
import Data.Foldable
|
|
|
|
import Debug.Trace
|
|
|
|
import Frontend.Autogen.Parser
|
|
import Frontend.Autogen.Lexer
|
|
import Frontend.Lexer.Wrapper
|
|
import Frontend.Lexer.Tokens
|
|
|
|
import System.Environment (getArgs)
|
|
|
|
import Text.Show.Pretty (pPrint)
|
|
import Frontend.Parser.Posn
|
|
import System.Posix.Internals
|
|
import GHC.IO.Handle.FD (stdout, handleToFd)
|
|
import GHC.IO.FD
|
|
import Data.Maybe (fromMaybe)
|
|
import Errors
|
|
|
|
main :: IO ()
|
|
main = do
|
|
args <- getArgs
|
|
for_ args $ \str -> do
|
|
Main.lex str (\_ -> putStrLn $ str ++ " parsed!") parseMod =<< Lbs.readFile str
|
|
|
|
testParse :: String -> IO ()
|
|
testParse s = Main.lex "<interactive>" pPrint parseMod (Lbs.fromStrict (T.encodeUtf8 (T.pack s)))
|
|
|
|
testLex :: String -> IO ()
|
|
testLex s = Main.lex "<interactive>" (const (pure ())) (scan []) (Lbs.fromStrict (T.encodeUtf8 (T.pack s)))
|
|
|
|
lex :: String -> (a -> IO ()) -> Alex a -> Lbs.ByteString -> IO ()
|
|
lex fname show cont arg = do
|
|
let
|
|
x = runAlex fname arg cont
|
|
color <- fmap (1 ==) . c_isatty . fdFD =<< handleToFd GHC.IO.Handle.FD.stdout
|
|
code <- if fname == "<interactive>"
|
|
then pure . lines $ T.unpack (T.decodeUtf8 (Lbs.toStrict arg))
|
|
else lines <$> readFile fname
|
|
case x of
|
|
Left e -> putStr $ showAhcError color code e
|
|
Right x -> show x
|
|
|
|
|
|
|
|
scan :: [Token] -> Alex [Token]
|
|
scan acc = do
|
|
tok <- alexMonadScan
|
|
sc <- alexGetStartCode
|
|
state <- getUserState
|
|
traceM . unlines $
|
|
[ "----------------"
|
|
, "just lexed: " ++ show tok
|
|
, "sc: " ++ show sc
|
|
, "sc stack: " ++ show (startCodes state)
|
|
, "layout stack: " ++ show (layoutColumns state)
|
|
]
|
|
case tokenClass tok of
|
|
TokEof -> pure (reverse acc)
|
|
_ -> scan (tok:acc)
|