-- -----------------------------------------------------------------------------
-- 
-- 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 cli file prg =
  let script = parseScript file prg in
  alex cli script

parseScript :: Maybe FilePath -> String
  -> (Maybe (AlexPosn,Code), [Directive], Scanner, Maybe (AlexPosn,Code))
parseScript maybeFile prg =
  let file = maybe "<no file>" id maybeFile in
  case runP prg initialParserEnv parse of
	Left (Just (AlexPn _ line col),err) -> 
		error (file ++ ":" ++ show line ++ ":" ++ show col
				 ++ ": " ++ err ++ "\n")
	Left (Nothing, err) ->
		error (file ++ ": " ++ err ++ "\n")

	Right script -> script



alex :: [CLIFlags]
     -> (Maybe (AlexPosn, Code), [Directive], Scanner, Maybe (AlexPosn, Code))
     -> (String,String)
alex cli script =
  let 
    target = if OptGhcTarget `elem` cli then GhcTarget else HaskellTarget
    encoding
      | OptLatin1 `elem` cli = Latin1	
      | otherwise            = UTF8
    (maybe_header, directives, scanner1, maybe_footer) = script
    (scanner2, scs, sc_hdr) = encodeStartCodes scanner1
    (scanner_final, actions) = extractActions scanner2
    dfa = scanner2dfa encoding scanner_final scs
    min_dfa = minimizeDFA dfa
    nm  = scannerName scanner_final
  in
   (maybe id ((++) . snd) (maybe_header) $ 
     maybe id (flip (++) . snd) (maybe_footer) $ 
     outputDFA target 1 nm min_dfa "" ++ (actions "") ++ (sc_hdr "")
      ,(infoDFA 1 nm min_dfa ""))

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

importsToInject :: Target -> [CLIFlags] -> String
importsToInject _ cli = always_imports ++ debug_imports ++ glaexts_import
  where
	glaexts_import | OptGhcTarget `elem` cli    = import_glaexts
		       | otherwise                  = ""

	debug_imports  | OptDebugParser `elem` cli = import_debug
		       | otherwise		   = ""

-- 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 = "#if __GLASGOW_HASKELL__ >= 603\n" ++
		 "#include \"ghcconfig.h\"\n" ++
		 "#elif defined(__GLASGOW_HASKELL__)\n" ++
		 "#include \"config.h\"\n" ++
		 "#endif\n" ++
		 "#if __GLASGOW_HASKELL__ >= 503\n" ++
		 "import Data.Array\n" ++
		 "import Data.Char (ord)\n" ++
		 "import Data.Array.Base (unsafeAt)\n" ++
		 "#else\n" ++
		 "import Array\n" ++
		 "import Char (ord)\n" ++
		 "#endif\n"

import_glaexts :: String
import_glaexts = "#if __GLASGOW_HASKELL__ >= 503\n" ++
		 "import GHC.Exts\n" ++
		 "#else\n" ++
		 "import GlaExts\n" ++
		 "#endif\n"

import_debug :: String 
import_debug   = "#if __GLASGOW_HASKELL__ >= 503\n" ++
		 "import System.IO\n" ++
		 "import System.IO.Unsafe\n" ++
		 "import Debug.Trace\n" ++
		 "#else\n" ++
		 "import IO\n" ++
		 "import IOExts\n" ++
		 "#endif\n"

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

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

initREEnv :: Map String RExp
initREEnv = Map.empty

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

data CLIFlags 
  = OptDebugParser
  | OptGhcTarget
  | OptInfoFile (Maybe FilePath)
  | OptLatin1
  | DumpHelp
  | DumpVersion
  deriving Eq