module Text.Alex (
runAlex
, CLIFlags(..)
, alex
, optsToInject
, importsToInject
, parseScript, Target(..)
) where
import AbsSyn
import CharSet
import DFA
import DFAMin
import NFA
import Info
import Map ( Map )
import qualified Map hiding ( Map )
import Output
import ParseMonad ( runP )
import Parser
import Scan
import Data.Char ( chr )
runAlex :: [CLIFlags] -> Maybe FilePath -> String -> (String,String)
runAlex :: [CLIFlags] -> Maybe String -> String -> (String, String)
runAlex [CLIFlags]
cli Maybe String
file String
prg =
let script :: (Maybe (AlexPosn, String), [Directive], Scanner,
Maybe (AlexPosn, String))
script = Maybe String
-> String
-> (Maybe (AlexPosn, String), [Directive], Scanner,
Maybe (AlexPosn, String))
parseScript Maybe String
file String
prg in
[CLIFlags]
-> (Maybe (AlexPosn, String), [Directive], Scanner,
Maybe (AlexPosn, String))
-> (String, String)
alex [CLIFlags]
cli (Maybe (AlexPosn, String), [Directive], Scanner,
Maybe (AlexPosn, String))
script
parseScript :: Maybe FilePath -> String
-> (Maybe (AlexPosn,Code), [Directive], Scanner, Maybe (AlexPosn,Code))
parseScript :: Maybe String
-> String
-> (Maybe (AlexPosn, String), [Directive], Scanner,
Maybe (AlexPosn, String))
parseScript Maybe String
maybeFile String
prg =
let file :: String
file = String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"<no file>" String -> String
forall a. a -> a
id Maybe String
maybeFile in
case String
-> (Map String CharSet, Map String RExp)
-> P (Maybe (AlexPosn, String), [Directive], Scanner,
Maybe (AlexPosn, String))
-> Either
ParseError
(Maybe (AlexPosn, String), [Directive], Scanner,
Maybe (AlexPosn, String))
forall a.
String
-> (Map String CharSet, Map String RExp)
-> P a
-> Either ParseError a
runP String
prg (Map String CharSet, Map String RExp)
initialParserEnv P (Maybe (AlexPosn, String), [Directive], Scanner,
Maybe (AlexPosn, String))
parse of
Left (Just (AlexPn Int
_ Int
line Int
col),String
err) ->
String
-> (Maybe (AlexPosn, String), [Directive], Scanner,
Maybe (AlexPosn, String))
forall a. HasCallStack => String -> a
error (String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
line String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
col
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n")
Left (Maybe AlexPosn
Nothing, String
err) ->
String
-> (Maybe (AlexPosn, String), [Directive], Scanner,
Maybe (AlexPosn, String))
forall a. HasCallStack => String -> a
error (String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n")
Right (Maybe (AlexPosn, String), [Directive], Scanner,
Maybe (AlexPosn, String))
script -> (Maybe (AlexPosn, String), [Directive], Scanner,
Maybe (AlexPosn, String))
script
alex :: [CLIFlags]
-> (Maybe (AlexPosn, Code), [Directive], Scanner, Maybe (AlexPosn, Code))
-> (String,String)
alex :: [CLIFlags]
-> (Maybe (AlexPosn, String), [Directive], Scanner,
Maybe (AlexPosn, String))
-> (String, String)
alex [CLIFlags]
cli (Maybe (AlexPosn, String), [Directive], Scanner,
Maybe (AlexPosn, String))
script =
let
target :: Target
target = if CLIFlags
OptGhcTarget CLIFlags -> [CLIFlags] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CLIFlags]
cli then Target
GhcTarget else Target
HaskellTarget
encoding :: Encoding
encoding
| CLIFlags
OptLatin1 CLIFlags -> [CLIFlags] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CLIFlags]
cli = Encoding
Latin1
| Bool
otherwise = Encoding
UTF8
(Maybe (AlexPosn, String)
maybe_header, [Directive]
directives, Scanner
scanner1, Maybe (AlexPosn, String)
maybe_footer) = (Maybe (AlexPosn, String), [Directive], Scanner,
Maybe (AlexPosn, String))
script
(Scanner
scanner2, [Int]
scs, String -> String
sc_hdr) = Scanner -> (Scanner, [Int], String -> String)
encodeStartCodes Scanner
scanner1
(Scanner
scanner_final, String -> String
actions) = Scanner -> (Scanner, String -> String)
extractActions Scanner
scanner2
dfa :: DFA Int String
dfa = Encoding -> Scanner -> [Int] -> DFA Int String
scanner2dfa Encoding
encoding Scanner
scanner_final [Int]
scs
min_dfa :: DFA Int String
min_dfa = DFA Int String -> DFA Int String
forall a. Ord a => DFA Int a -> DFA Int a
minimizeDFA DFA Int String
dfa
nm :: String
nm = Scanner -> String
scannerName Scanner
scanner_final
in
((String -> String)
-> ((AlexPosn, String) -> String -> String)
-> Maybe (AlexPosn, String)
-> String
-> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String -> String
forall a. a -> a
id (String -> String -> String
forall a. [a] -> [a] -> [a]
(++) (String -> String -> String)
-> ((AlexPosn, String) -> String)
-> (AlexPosn, String)
-> String
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AlexPosn, String) -> String
forall a b. (a, b) -> b
snd) (Maybe (AlexPosn, String)
maybe_header) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
(String -> String)
-> ((AlexPosn, String) -> String -> String)
-> Maybe (AlexPosn, String)
-> String
-> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String -> String
forall a. a -> a
id ((String -> String -> String) -> String -> String -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> String -> String
forall a. [a] -> [a] -> [a]
(++) (String -> String -> String)
-> ((AlexPosn, String) -> String)
-> (AlexPosn, String)
-> String
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AlexPosn, String) -> String
forall a b. (a, b) -> b
snd) (Maybe (AlexPosn, String)
maybe_footer) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
Target -> Int -> String -> DFA Int String -> String -> String
outputDFA Target
target Int
1 String
nm DFA Int String
min_dfa String
"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
actions String
"") String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
sc_hdr String
"")
,(Int -> String -> DFA Int String -> String -> String
infoDFA Int
1 String
nm DFA Int String
min_dfa String
""))
optsToInject :: Target -> [CLIFlags] -> String
optsToInject :: Target -> [CLIFlags] -> String
optsToInject Target
GhcTarget [CLIFlags]
_ = String
"{-# OPTIONS -fglasgow-exts -cpp #-}\n"
optsToInject Target
_ [CLIFlags]
_ = String
"{-# OPTIONS -cpp #-}\n"
importsToInject :: Target -> [CLIFlags] -> String
importsToInject :: Target -> [CLIFlags] -> String
importsToInject Target
_ [CLIFlags]
cli = String
always_imports String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
debug_imports String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
glaexts_import
where
glaexts_import :: String
glaexts_import | CLIFlags
OptGhcTarget CLIFlags -> [CLIFlags] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CLIFlags]
cli = String
import_glaexts
| Bool
otherwise = String
""
debug_imports :: String
debug_imports | CLIFlags
OptDebugParser CLIFlags -> [CLIFlags] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CLIFlags]
cli = String
import_debug
| Bool
otherwise = String
""
always_imports :: String
always_imports :: String
always_imports = String
"#if __GLASGOW_HASKELL__ >= 603\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"#include \"ghcconfig.h\"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"#elif defined(__GLASGOW_HASKELL__)\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"#include \"config.h\"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"#endif\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"#if __GLASGOW_HASKELL__ >= 503\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"import Data.Array\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"import Data.Char (ord)\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"import Data.Array.Base (unsafeAt)\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"#else\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"import Array\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"import Char (ord)\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"#endif\n"
import_glaexts :: String
import_glaexts :: String
import_glaexts = String
"#if __GLASGOW_HASKELL__ >= 503\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"import GHC.Exts\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"#else\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"import GlaExts\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"#endif\n"
import_debug :: String
import_debug :: String
import_debug = String
"#if __GLASGOW_HASKELL__ >= 503\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"import System.IO\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"import System.IO.Unsafe\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"import Debug.Trace\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"#else\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"import IO\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"import IOExts\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"#endif\n"
initialParserEnv :: (Map String CharSet, Map String RExp)
initialParserEnv :: (Map String CharSet, Map String RExp)
initialParserEnv = (Map String CharSet
initSetEnv, Map String RExp
initREEnv)
initSetEnv :: Map String CharSet
initSetEnv :: Map String CharSet
initSetEnv = [(String, CharSet)] -> Map String CharSet
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String
"white", String -> CharSet
charSet String
" \t\n\v\f\r"),
(String
"printable", Char -> Char -> CharSet
charSetRange (Int -> Char
chr Int
32) (Int -> Char
chr Int
0x10FFFF)),
(String
".", CharSet -> CharSet
charSetComplement CharSet
emptyCharSet
CharSet -> CharSet -> CharSet
`charSetMinus` Char -> CharSet
charSetSingleton Char
'\n')]
initREEnv :: Map String RExp
initREEnv :: Map String RExp
initREEnv = Map String RExp
forall k a. Map k a
Map.empty
data CLIFlags
= OptDebugParser
| OptGhcTarget
| OptInfoFile (Maybe FilePath)
| OptLatin1
| DumpHelp
| DumpVersion
deriving CLIFlags -> CLIFlags -> Bool
(CLIFlags -> CLIFlags -> Bool)
-> (CLIFlags -> CLIFlags -> Bool) -> Eq CLIFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CLIFlags -> CLIFlags -> Bool
$c/= :: CLIFlags -> CLIFlags -> Bool
== :: CLIFlags -> CLIFlags -> Bool
$c== :: CLIFlags -> CLIFlags -> Bool
Eq