- -- {-# 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)
|