-- Copyright (C) 2018-2024 Jun Zhang <zhangjunphy[at]gmail[dot]com>
--
-- This file is a part of decafc.
--
-- decafc is free software: you can redistribute it and/or modify it under the
-- terms of the MIT (X11) License as described in the LICENSE file.
--
-- decafc is distributed in the hope that it will be useful, but WITHOUT ANY
-- WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE.  See the X11 license for more details.

-- Lexer entry point
module Lexer
  ( Token (..),
    Alex (..),
    AlexState (..),
    AlexUserState(..),
    scan,
    alexMonadScan,
    runAlex,
    addError,
    alexError,
    getAlexState
  )
where

import Data.ByteString.Lazy (ByteString)
import Lexer.Lex
import Lexer.Token
import Util.SourceLoc qualified as SL
import Types (CompileError(..))
import Data.Text qualified as Text

-- Produce error tokens for later use
catchErrors :: SL.Located Token -> Alex ()
catchErrors :: Located Token -> Alex ()
catchErrors Located Token
tok = do
  AlexState
s <- Alex AlexState
getAlexState
  case Located Token
tok of 
    t :: Located Token
t@(SL.LocatedAt Range
_ Token
EOF) -> AlexState -> Located Token -> Alex ()
forall {a}. AlexState -> Located a -> Alex ()
eofCheck AlexState
s Located Token
t
    Located Token
t -> () -> Alex ()
forall a. a -> Alex a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    eofCheck :: AlexState -> Located a -> Alex ()
eofCheck s :: AlexState
s@AlexState {$sel:alex_ust:AlexState :: AlexState -> AlexUserState
alex_ust = AlexUserState
ust} tok :: Located a
tok@(SL.LocatedAt Range
loc a
_) =
      case AlexUserState
ust of
        AlexUserState
val
          | AlexUserState -> Bool
lexerStringState AlexUserState
ust -> CompileError -> Alex ()
addError (CompileError -> Alex ()) -> CompileError -> Alex ()
forall a b. (a -> b) -> a -> b
$ Maybe Range -> Text -> CompileError
CompileError (Range -> Maybe Range
forall a. a -> Maybe a
Just Range
loc) Text
"String not closed at EOF"
          | AlexUserState -> Bool
lexerCharState AlexUserState
ust -> CompileError -> Alex ()
addError (CompileError -> Alex ()) -> CompileError -> Alex ()
forall a b. (a -> b) -> a -> b
$ Maybe Range -> Text -> CompileError
CompileError (Range -> Maybe Range
forall a. a -> Maybe a
Just Range
loc) Text
"Char not closed at EOF"
          | AlexUserState -> Int
lexerCommentDepth AlexUserState
ust Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> CompileError -> Alex ()
addError (CompileError -> Alex ()) -> CompileError -> Alex ()
forall a b. (a -> b) -> a -> b
$ Maybe Range -> Text -> CompileError
CompileError (Range -> Maybe Range
forall a. a -> Maybe a
Just Range
loc) Text
"Comment not closed at EOF"
          | Bool
otherwise -> () -> Alex ()
forall a. a -> Alex a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

scan :: ByteString -> Either [CompileError] [SL.Located Token]
scan :: ByteString -> Either [CompileError] [Located Token]
scan ByteString
str =
  let loop :: Alex [Located Token]
loop = do
        tok' :: Located Token
tok'@(SL.LocatedAt Range
_ Token
tok) <- Alex (Located Token)
alexMonadScan
        Located Token -> Alex ()
catchErrors Located Token
tok'
        if Token
tok Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token
EOF
          then [Located Token] -> Alex [Located Token]
forall a. a -> Alex a
forall (m :: * -> *) a. Monad m => a -> m a
return []
          else do
            [Located Token]
toks <- Alex [Located Token]
loop
            [Located Token] -> Alex [Located Token]
forall a. a -> Alex a
forall (m :: * -> *) a. Monad m => a -> m a
return (Located Token
tok' Located Token -> [Located Token] -> [Located Token]
forall a. a -> [a] -> [a]
: [Located Token]
toks)
      tokenAndErrors :: Alex ([CompileError], [Located Token])
tokenAndErrors = Alex [Located Token]
loop Alex [Located Token]
-> ([Located Token] -> Alex ([CompileError], [Located Token]))
-> Alex ([CompileError], [Located Token])
forall a b. Alex a -> (a -> Alex b) -> Alex b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Located Token]
tokens -> do
        AlexState
state <- Alex AlexState
getAlexState
        let errs :: [CompileError]
errs = AlexUserState -> [CompileError]
errors (AlexUserState -> [CompileError])
-> AlexUserState -> [CompileError]
forall a b. (a -> b) -> a -> b
$ AlexState -> AlexUserState
alex_ust AlexState
state
        ([CompileError], [Located Token])
-> Alex ([CompileError], [Located Token])
forall a. a -> Alex a
forall (m :: * -> *) a. Monad m => a -> m a
return ([CompileError]
errs, [Located Token]
tokens)
   in case ByteString
-> Alex ([CompileError], [Located Token])
-> Either String ([CompileError], [Located Token])
forall a. ByteString -> Alex a -> Either String a
runAlex ByteString
str Alex ([CompileError], [Located Token])
tokenAndErrors of
        Left String
m -> [CompileError] -> Either [CompileError] [Located Token]
forall a b. a -> Either a b
Left [Maybe Range -> Text -> CompileError
CompileError Maybe Range
forall a. Maybe a
Nothing (Text -> CompileError) -> Text -> CompileError
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
m]
        Right ([CompileError]
errs, [Located Token]
_) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [CompileError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CompileError]
errs -> [CompileError] -> Either [CompileError] [Located Token]
forall a b. a -> Either a b
Left [CompileError]
errs
        Right ([CompileError]
_, [Located Token]
toks) -> [Located Token] -> Either [CompileError] [Located Token]
forall a b. b -> Either a b
Right [Located Token]
toks