-- -----------------------------------------------------------------------------
-- 
-- Alex.hs, part of Alex
--
-- (c) Chris Dornan 1995-2000, Simon Marlow 2003
--
-- ----------------------------------------------------------------------------}

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 FilePath -> FilePath -> (FilePath, FilePath)
runAlex [CLIFlags]
cli Maybe FilePath
file FilePath
prg =
  let script :: (Maybe (AlexPosn, FilePath), [Directive], Scanner,
 Maybe (AlexPosn, FilePath))
script = Maybe FilePath
-> FilePath
-> (Maybe (AlexPosn, FilePath), [Directive], Scanner,
    Maybe (AlexPosn, FilePath))
parseScript Maybe FilePath
file FilePath
prg in
  [CLIFlags]
-> (Maybe (AlexPosn, FilePath), [Directive], Scanner,
    Maybe (AlexPosn, FilePath))
-> (FilePath, FilePath)
alex [CLIFlags]
cli (Maybe (AlexPosn, FilePath), [Directive], Scanner,
 Maybe (AlexPosn, FilePath))
script

parseScript :: Maybe FilePath -> String
  -> (Maybe (AlexPosn,Code), [Directive], Scanner, Maybe (AlexPosn,Code))
parseScript :: Maybe FilePath
-> FilePath
-> (Maybe (AlexPosn, FilePath), [Directive], Scanner,
    Maybe (AlexPosn, FilePath))
parseScript Maybe FilePath
maybeFile FilePath
prg =
  let file :: FilePath
file = FilePath -> (FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"<no file>" FilePath -> FilePath
forall a. a -> a
id Maybe FilePath
maybeFile in
  case FilePath
-> (Map FilePath CharSet, Map FilePath RExp)
-> P (Maybe (AlexPosn, FilePath), [Directive], Scanner,
      Maybe (AlexPosn, FilePath))
-> Either
     ParseError
     (Maybe (AlexPosn, FilePath), [Directive], Scanner,
      Maybe (AlexPosn, FilePath))
forall a.
FilePath
-> (Map FilePath CharSet, Map FilePath RExp)
-> P a
-> Either ParseError a
runP FilePath
prg (Map FilePath CharSet, Map FilePath RExp)
initialParserEnv P (Maybe (AlexPosn, FilePath), [Directive], Scanner,
   Maybe (AlexPosn, FilePath))
parse of
        Left (Just (AlexPn Int
_ Int
line Int
col),FilePath
err) -> 
                FilePath
-> (Maybe (AlexPosn, FilePath), [Directive], Scanner,
    Maybe (AlexPosn, FilePath))
forall a. HasCallStack => FilePath -> a
error (FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
":" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
line FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
":" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
col
                                 FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
err FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n")
        Left (Maybe AlexPosn
Nothing, FilePath
err) ->
                FilePath
-> (Maybe (AlexPosn, FilePath), [Directive], Scanner,
    Maybe (AlexPosn, FilePath))
forall a. HasCallStack => FilePath -> a
error (FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
err FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n")

        Right (Maybe (AlexPosn, FilePath), [Directive], Scanner,
 Maybe (AlexPosn, FilePath))
script -> (Maybe (AlexPosn, FilePath), [Directive], Scanner,
 Maybe (AlexPosn, FilePath))
script



alex :: [CLIFlags]
     -> (Maybe (AlexPosn, Code), [Directive], Scanner, Maybe (AlexPosn, Code))
     -> (String,String)
alex :: [CLIFlags]
-> (Maybe (AlexPosn, FilePath), [Directive], Scanner,
    Maybe (AlexPosn, FilePath))
-> (FilePath, FilePath)
alex [CLIFlags]
cli (Maybe (AlexPosn, FilePath), [Directive], Scanner,
 Maybe (AlexPosn, FilePath))
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, FilePath)
maybe_header, [Directive]
directives, Scanner
scanner1, Maybe (AlexPosn, FilePath)
maybe_footer) = (Maybe (AlexPosn, FilePath), [Directive], Scanner,
 Maybe (AlexPosn, FilePath))
script
    (Scanner
scanner2, [Int]
scs, FilePath -> FilePath
sc_hdr) = Scanner -> (Scanner, [Int], FilePath -> FilePath)
encodeStartCodes Scanner
scanner1
    (Scanner
scanner_final, FilePath -> FilePath
actions) = Scanner -> (Scanner, FilePath -> FilePath)
extractActions Scanner
scanner2
    dfa :: DFA Int FilePath
dfa = Encoding -> Scanner -> [Int] -> DFA Int FilePath
scanner2dfa Encoding
encoding Scanner
scanner_final [Int]
scs
    min_dfa :: DFA Int FilePath
min_dfa = DFA Int FilePath -> DFA Int FilePath
forall a. Ord a => DFA Int a -> DFA Int a
minimizeDFA DFA Int FilePath
dfa
    nm :: FilePath
nm  = Scanner -> FilePath
scannerName Scanner
scanner_final
  in
   ((FilePath -> FilePath)
-> ((AlexPosn, FilePath) -> FilePath -> FilePath)
-> Maybe (AlexPosn, FilePath)
-> FilePath
-> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath -> FilePath
forall a. a -> a
id (FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
(++) (FilePath -> FilePath -> FilePath)
-> ((AlexPosn, FilePath) -> FilePath)
-> (AlexPosn, FilePath)
-> FilePath
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AlexPosn, FilePath) -> FilePath
forall a b. (a, b) -> b
snd) (Maybe (AlexPosn, FilePath)
maybe_header) (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ 
     (FilePath -> FilePath)
-> ((AlexPosn, FilePath) -> FilePath -> FilePath)
-> Maybe (AlexPosn, FilePath)
-> FilePath
-> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath -> FilePath
forall a. a -> a
id ((FilePath -> FilePath -> FilePath)
-> FilePath -> FilePath -> FilePath
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
(++) (FilePath -> FilePath -> FilePath)
-> ((AlexPosn, FilePath) -> FilePath)
-> (AlexPosn, FilePath)
-> FilePath
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AlexPosn, FilePath) -> FilePath
forall a b. (a, b) -> b
snd) (Maybe (AlexPosn, FilePath)
maybe_footer) (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ 
     Target
-> Int -> FilePath -> DFA Int FilePath -> FilePath -> FilePath
outputDFA Target
target Int
1 FilePath
nm DFA Int FilePath
min_dfa FilePath
"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (FilePath -> FilePath
actions FilePath
"") FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (FilePath -> FilePath
sc_hdr FilePath
"")
      ,(Int -> FilePath -> DFA Int FilePath -> FilePath -> FilePath
infoDFA Int
1 FilePath
nm DFA Int FilePath
min_dfa FilePath
""))

optsToInject :: Target -> [CLIFlags] -> String
optsToInject :: Target -> [CLIFlags] -> FilePath
optsToInject Target
GhcTarget [CLIFlags]
_ = FilePath
"{-# OPTIONS -fglasgow-exts -cpp #-}\n"
optsToInject Target
_         [CLIFlags]
_ = FilePath
"{-# OPTIONS -cpp #-}\n"

importsToInject :: Target -> [CLIFlags] -> String
importsToInject :: Target -> [CLIFlags] -> FilePath
importsToInject Target
_ [CLIFlags]
cli = FilePath
always_imports FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
debug_imports FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
glaexts_import
  where
        glaexts_import :: FilePath
glaexts_import | CLIFlags
OptGhcTarget CLIFlags -> [CLIFlags] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CLIFlags]
cli    = FilePath
import_glaexts
                       | Bool
otherwise                  = FilePath
""

        debug_imports :: FilePath
debug_imports  | CLIFlags
OptDebugParser CLIFlags -> [CLIFlags] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CLIFlags]
cli = FilePath
import_debug
                       | Bool
otherwise                 = FilePath
""

-- CPP is turned on for -fglasogw-exts, so we can use conditional
-- compilation.  We need to #include "config.h" to get hold of
-- WORDS_BIGENDIAN (see GenericTemplate.hs).

always_imports :: String
always_imports :: FilePath
always_imports = FilePath
"#if __GLASGOW_HASKELL__ >= 603\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                 FilePath
"#include \"ghcconfig.h\"\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                 FilePath
"#elif defined(__GLASGOW_HASKELL__)\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                 FilePath
"#include \"config.h\"\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                 FilePath
"#endif\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                 FilePath
"#if __GLASGOW_HASKELL__ >= 503\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                 FilePath
"import Data.Array\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                 FilePath
"import Data.Char (ord)\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                 FilePath
"import Data.Array.Base (unsafeAt)\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                 FilePath
"#else\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                 FilePath
"import Array\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                 FilePath
"import Char (ord)\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                 FilePath
"#endif\n"

import_glaexts :: String
import_glaexts :: FilePath
import_glaexts = FilePath
"#if __GLASGOW_HASKELL__ >= 503\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                 FilePath
"import GHC.Exts\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                 FilePath
"#else\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                 FilePath
"import GlaExts\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                 FilePath
"#endif\n"

import_debug :: String 
import_debug :: FilePath
import_debug   = FilePath
"#if __GLASGOW_HASKELL__ >= 503\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                 FilePath
"import System.IO\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                 FilePath
"import System.IO.Unsafe\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                 FilePath
"import Debug.Trace\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                 FilePath
"#else\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                 FilePath
"import IO\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                 FilePath
"import IOExts\n" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                 FilePath
"#endif\n"

initialParserEnv :: (Map String CharSet, Map String RExp)
initialParserEnv :: (Map FilePath CharSet, Map FilePath RExp)
initialParserEnv = (Map FilePath CharSet
initSetEnv, Map FilePath RExp
initREEnv)

initSetEnv :: Map String CharSet
initSetEnv :: Map FilePath CharSet
initSetEnv = [(FilePath, CharSet)] -> Map FilePath CharSet
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(FilePath
"white", FilePath -> CharSet
charSet FilePath
" \t\n\v\f\r"),
                           (FilePath
"printable", Char -> Char -> CharSet
charSetRange (Int -> Char
chr Int
32) (Int -> Char
chr Int
0x10FFFF)), -- FIXME: Look it up the unicode standard
                           (FilePath
".", CharSet -> CharSet
charSetComplement CharSet
emptyCharSet 
                            CharSet -> CharSet -> CharSet
`charSetMinus` Char -> CharSet
charSetSingleton Char
'\n')]

initREEnv :: Map String RExp
initREEnv :: Map FilePath RExp
initREEnv = Map FilePath RExp
forall k a. Map k a
Map.empty

-- -----------------------------------------------------------------------------
-- Command-line flags

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