{- | Line-by-line syntax highlighting for assembler sources and simulation
reports. Concatenating the token texts gives back the original line.
-}
module Wrench.Highlight (
    TokenKind (..),
    tokenizeLine,
    tokenizeReportLine,
) where

import Data.Char (isAlphaNum, isDigit, isHexDigit, isLower, isSpace, isUpper)
import Data.Text qualified as T
import Relude
import Wrench.Isa (Isa (..))
import Wrench.Isa.F32a (f32aMnemonics)
import Wrench.Isa.Wasm32 (wasm32Mnemonics)

data TokenKind
    = Plain
    | Comment
    | Label
    | Directive
    | Mnemonic
    | Register
    | Literal
    | Reloc
    | Ref
    | Call
    | Separator
    deriving (TokenKind -> TokenKind -> Bool
(TokenKind -> TokenKind -> Bool)
-> (TokenKind -> TokenKind -> Bool) -> Eq TokenKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TokenKind -> TokenKind -> Bool
== :: TokenKind -> TokenKind -> Bool
$c/= :: TokenKind -> TokenKind -> Bool
/= :: TokenKind -> TokenKind -> Bool
Eq, Int -> TokenKind -> ShowS
[TokenKind] -> ShowS
TokenKind -> String
(Int -> TokenKind -> ShowS)
-> (TokenKind -> String)
-> ([TokenKind] -> ShowS)
-> Show TokenKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TokenKind -> ShowS
showsPrec :: Int -> TokenKind -> ShowS
$cshow :: TokenKind -> String
show :: TokenKind -> String
$cshowList :: [TokenKind] -> ShowS
showList :: [TokenKind] -> ShowS
Show)

data Lexeme
    = LSpace Text
    | LString Text
    | LLabel Text
    | LWord Text
    | LPunct Char

tokenizeLine :: Isa -> Text -> [(TokenKind, Text)]
tokenizeLine :: Isa -> Text -> [(TokenKind, Text)]
tokenizeLine Isa
isa Text
line =
    let (Text
code, Text
comment) = Char -> Text -> (Text, Text)
splitComment (Isa -> Char
commentChar Isa
isa) Text
line
        tokens :: [(TokenKind, Text)]
tokens = Isa -> [Lexeme] -> [(TokenKind, Text)]
classify Isa
isa (Isa -> String -> [Lexeme]
lexCode Isa
isa (Text -> String
forall a. ToString a => a -> String
toString Text
code))
     in (if Isa
isa Isa -> Isa -> Bool
forall a. Eq a => a -> a -> Bool
== Isa
F32a then [(TokenKind, Text)] -> [(TokenKind, Text)]
f32aCalls [(TokenKind, Text)]
tokens else [(TokenKind, Text)]
tokens) [(TokenKind, Text)] -> [(TokenKind, Text)] -> [(TokenKind, Text)]
forall a. Semigroup a => a -> a -> a
<> [(TokenKind
Comment, Text
comment) | Bool -> Bool
not (Text -> Bool
T.null Text
comment)]

commentChar :: Isa -> Char
commentChar :: Isa -> Char
commentChar Isa
F32a = Char
'\\'
commentChar Isa
_ = Char
';'

splitComment :: Char -> Text -> (Text, Text)
splitComment :: Char -> Text -> (Text, Text)
splitComment Char
c Text
line = Int -> Text -> (Text, Text)
T.splitAt (Int -> Maybe Char -> String -> Int
go Int
0 Maybe Char
forall a. Maybe a
Nothing (Text -> String
forall a. ToString a => a -> String
toString Text
line)) Text
line
    where
        go :: Int -> Maybe Char -> String -> Int
        go :: Int -> Maybe Char -> String -> Int
go Int
i Maybe Char
_ [] = Int
i
        go Int
i Maybe Char
Nothing (Char
x : String
xs)
            | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c = Int
i
            | Char -> Bool
isQuote Char
x = Int -> Maybe Char -> String -> Int
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
x) String
xs
            | Bool
otherwise = Int -> Maybe Char -> String -> Int
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Maybe Char
forall a. Maybe a
Nothing String
xs
        go Int
i (Just Char
q) (Char
x : String
xs)
            | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\', Char
_ : String
xs' <- String
xs = Int -> Maybe Char -> String -> Int
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
q) String
xs'
            | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
q = Int -> Maybe Char -> String -> Int
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Maybe Char
forall a. Maybe a
Nothing String
xs
            | Bool
otherwise = Int -> Maybe Char -> String -> Int
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
q) String
xs

isQuote :: Char -> Bool
isQuote :: Char -> Bool
isQuote Char
x = Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"'

lexCode :: Isa -> String -> [Lexeme]
lexCode :: Isa -> String -> [Lexeme]
lexCode Isa
_ [] = []
lexCode Isa
isa s :: String
s@(Char
x : String
xs)
    | Char -> Bool
isSpace Char
x =
        let (String
sp, String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isSpace String
s
         in Text -> Lexeme
LSpace (String -> Text
forall a. ToText a => a -> Text
toText String
sp) Lexeme -> [Lexeme] -> [Lexeme]
forall a. a -> [a] -> [a]
: Isa -> String -> [Lexeme]
lexCode Isa
isa String
rest
    | Char -> Bool
isQuote Char
x =
        let (String
str, String
rest) = Char -> String -> (String, String)
quoted Char
x String
xs
         in Text -> Lexeme
LString (String -> Text
forall a. ToText a => a -> Text
toText (Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
str)) Lexeme -> [Lexeme] -> [Lexeme]
forall a. a -> [a] -> [a]
: Isa -> String -> [Lexeme]
lexCode Isa
isa String
rest
    | Isa
isa Isa -> Isa -> Bool
forall a. Eq a => a -> a -> Bool
== Isa
F32a =
        let (String
w, String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace String
s
         in String -> Lexeme
wordOrLabel String
w Lexeme -> [Lexeme] -> [Lexeme]
forall a. a -> [a] -> [a]
: Isa -> String -> [Lexeme]
lexCode Isa
isa String
rest
    | Char -> Bool
isWordChar Char
x Bool -> Bool -> Bool
|| (Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
&& Bool -> (Char -> Bool) -> Maybe Char -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Char -> Bool
isDigit ((NonEmpty Char -> Char) -> String -> Maybe Char
forall a b. (NonEmpty a -> b) -> [a] -> Maybe b
viaNonEmpty NonEmpty Char -> Char
forall (f :: * -> *) a. IsNonEmpty f a a "head" => f a -> a
head String
xs)) =
        let (String
w, String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isWordChar String
xs
         in case String
rest of
                Char
':' : String
rest' -> Text -> Lexeme
LLabel (String -> Text
forall a. ToText a => a -> Text
toText (Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
w String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":")) Lexeme -> [Lexeme] -> [Lexeme]
forall a. a -> [a] -> [a]
: Isa -> String -> [Lexeme]
lexCode Isa
isa String
rest'
                String
_ -> Text -> Lexeme
LWord (String -> Text
forall a. ToText a => a -> Text
toText (Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
w)) Lexeme -> [Lexeme] -> [Lexeme]
forall a. a -> [a] -> [a]
: Isa -> String -> [Lexeme]
lexCode Isa
isa String
rest
    | Bool
otherwise = Char -> Lexeme
LPunct Char
x Lexeme -> [Lexeme] -> [Lexeme]
forall a. a -> [a] -> [a]
: Isa -> String -> [Lexeme]
lexCode Isa
isa String
xs
    where
        wordOrLabel :: String -> Lexeme
wordOrLabel String
w
            | String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1, Just Char
':' <- (NonEmpty Char -> Char) -> String -> Maybe Char
forall a b. (NonEmpty a -> b) -> [a] -> Maybe b
viaNonEmpty NonEmpty Char -> Char
forall (f :: * -> *) a. IsNonEmpty f a a "last" => f a -> a
last String
w = Text -> Lexeme
LLabel (String -> Text
forall a. ToText a => a -> Text
toText String
w)
            | Bool
otherwise = Text -> Lexeme
LWord (String -> Text
forall a. ToText a => a -> Text
toText String
w)

quoted :: Char -> String -> (String, String)
quoted :: Char -> String -> (String, String)
quoted Char
_ [] = ([], [])
quoted Char
q (Char
'\\' : Char
e : String
rest) = ShowS -> (String, String) -> (String, String)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([Char
'\\', Char
e] String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) (Char -> String -> (String, String)
quoted Char
q String
rest)
quoted Char
q (Char
c : String
rest)
    | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
q = ([Char
c], String
rest)
    | Bool
otherwise = ShowS -> (String, String) -> (String, String)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Char
c Char -> ShowS
forall a. a -> [a] -> [a]
:) (Char -> String -> (String, String)
quoted Char
q String
rest)

isWordChar :: Char -> Bool
isWordChar :: Char -> Bool
isWordChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` (String
"_.%$" :: String)

classify :: Isa -> [Lexeme] -> [(TokenKind, Text)]
classify :: Isa -> [Lexeme] -> [(TokenKind, Text)]
classify Isa
isa = Bool -> [Lexeme] -> [(TokenKind, Text)]
go Bool
True
    where
        go :: Bool -> [Lexeme] -> [(TokenKind, Text)]
go Bool
_ [] = []
        go Bool
statementStart (Lexeme
l : [Lexeme]
ls) = case Lexeme
l of
            LSpace Text
t -> (TokenKind
Plain, Text
t) (TokenKind, Text) -> [(TokenKind, Text)] -> [(TokenKind, Text)]
forall a. a -> [a] -> [a]
: Bool -> [Lexeme] -> [(TokenKind, Text)]
go Bool
statementStart [Lexeme]
ls
            LString Text
t -> (TokenKind
Literal, Text
t) (TokenKind, Text) -> [(TokenKind, Text)] -> [(TokenKind, Text)]
forall a. a -> [a] -> [a]
: Bool -> [Lexeme] -> [(TokenKind, Text)]
go Bool
False [Lexeme]
ls
            LLabel Text
t -> (TokenKind
Label, Text
t) (TokenKind, Text) -> [(TokenKind, Text)] -> [(TokenKind, Text)]
forall a. a -> [a] -> [a]
: Bool -> [Lexeme] -> [(TokenKind, Text)]
go Bool
statementStart [Lexeme]
ls
            LPunct Char
'/' | Isa
isa Isa -> Isa -> Bool
forall a. Eq a => a -> a -> Bool
== Isa
VliwIv -> (TokenKind
Separator, Text
"/") (TokenKind, Text) -> [(TokenKind, Text)] -> [(TokenKind, Text)]
forall a. a -> [a] -> [a]
: Bool -> [Lexeme] -> [(TokenKind, Text)]
go Bool
True [Lexeme]
ls
            LPunct Char
c -> (TokenKind
Plain, OneItem Text -> Text
forall x. One x => OneItem x -> x
one Char
OneItem Text
c) (TokenKind, Text) -> [(TokenKind, Text)] -> [(TokenKind, Text)]
forall a. a -> [a] -> [a]
: Bool -> [Lexeme] -> [(TokenKind, Text)]
go Bool
statementStart [Lexeme]
ls
            LWord Text
w
                | Text -> Bool
isNumber Text
w -> (TokenKind
Literal, Text
w) (TokenKind, Text) -> [(TokenKind, Text)] -> [(TokenKind, Text)]
forall a. a -> [a] -> [a]
: Bool -> [Lexeme] -> [(TokenKind, Text)]
go Bool
False [Lexeme]
ls
                | Text
"." Text -> Text -> Bool
`T.isPrefixOf` Text
w -> (TokenKind
Directive, Text
w) (TokenKind, Text) -> [(TokenKind, Text)] -> [(TokenKind, Text)]
forall a. a -> [a] -> [a]
: Bool -> [Lexeme] -> [(TokenKind, Text)]
go Bool
False [Lexeme]
ls
                | Text
"%" Text -> Text -> Bool
`T.isPrefixOf` Text
w -> (TokenKind
Reloc, Text
w) (TokenKind, Text) -> [(TokenKind, Text)] -> [(TokenKind, Text)]
forall a. a -> [a] -> [a]
: Bool -> [Lexeme] -> [(TokenKind, Text)]
go Bool
False [Lexeme]
ls
                | Isa
isa Isa -> Isa -> Bool
forall a. Eq a => a -> a -> Bool
== Isa
Wasm32, Text
"$" Text -> Text -> Bool
`T.isPrefixOf` Text
w -> (TokenKind
Register, Text
w) (TokenKind, Text) -> [(TokenKind, Text)] -> [(TokenKind, Text)]
forall a. a -> [a] -> [a]
: Bool -> [Lexeme] -> [(TokenKind, Text)]
go Bool
False [Lexeme]
ls
                | Just [Text]
known <- Isa -> Maybe [Text]
mnemonics Isa
isa -> (if Text
w Text -> [Text] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [Text]
known then TokenKind
Mnemonic else TokenKind
Ref, Text
w) (TokenKind, Text) -> [(TokenKind, Text)] -> [(TokenKind, Text)]
forall a. a -> [a] -> [a]
: Bool -> [Lexeme] -> [(TokenKind, Text)]
go Bool
False [Lexeme]
ls
                | Bool
statementStart -> (TokenKind
Mnemonic, Text
w) (TokenKind, Text) -> [(TokenKind, Text)] -> [(TokenKind, Text)]
forall a. a -> [a] -> [a]
: Bool -> [Lexeme] -> [(TokenKind, Text)]
go Bool
False [Lexeme]
ls
                | Isa -> Text -> Bool
isRegister Isa
isa Text
w -> (TokenKind
Register, Text
w) (TokenKind, Text) -> [(TokenKind, Text)] -> [(TokenKind, Text)]
forall a. a -> [a] -> [a]
: Bool -> [Lexeme] -> [(TokenKind, Text)]
go Bool
False [Lexeme]
ls
                | Bool
otherwise -> (TokenKind
Ref, Text
w) (TokenKind, Text) -> [(TokenKind, Text)] -> [(TokenKind, Text)]
forall a. a -> [a] -> [a]
: Bool -> [Lexeme] -> [(TokenKind, Text)]
go Bool
False [Lexeme]
ls

mnemonics :: Isa -> Maybe [Text]
mnemonics :: Isa -> Maybe [Text]
mnemonics Isa
F32a = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text]
f32aMnemonics
mnemonics Isa
Wasm32 = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text]
wasm32Mnemonics
mnemonics Isa
_ = Maybe [Text]
forall a. Maybe a
Nothing

-- | A bare f32a word is a call unless it is the argument of a mnemonic.
f32aCalls :: [(TokenKind, Text)] -> [(TokenKind, Text)]
f32aCalls :: [(TokenKind, Text)] -> [(TokenKind, Text)]
f32aCalls = Bool -> [(TokenKind, Text)] -> [(TokenKind, Text)]
forall {a}.
(Eq a, IsString a) =>
Bool -> [(TokenKind, a)] -> [(TokenKind, a)]
go Bool
False
    where
        go :: Bool -> [(TokenKind, a)] -> [(TokenKind, a)]
go Bool
_ [] = []
        go Bool
arg (tok :: (TokenKind, a)
tok@(TokenKind
kind, a
t) : [(TokenKind, a)]
ts) = case TokenKind
kind of
            TokenKind
Plain -> (TokenKind, a)
tok (TokenKind, a) -> [(TokenKind, a)] -> [(TokenKind, a)]
forall a. a -> [a] -> [a]
: Bool -> [(TokenKind, a)] -> [(TokenKind, a)]
go Bool
arg [(TokenKind, a)]
ts
            TokenKind
Ref | Bool -> Bool
not Bool
arg -> (TokenKind
Call, a
t) (TokenKind, a) -> [(TokenKind, a)] -> [(TokenKind, a)]
forall a. a -> [a] -> [a]
: Bool -> [(TokenKind, a)] -> [(TokenKind, a)]
go Bool
False [(TokenKind, a)]
ts
            TokenKind
_ -> (TokenKind, a)
tok (TokenKind, a) -> [(TokenKind, a)] -> [(TokenKind, a)]
forall a. a -> [a] -> [a]
: Bool -> [(TokenKind, a)] -> [(TokenKind, a)]
go (TokenKind
kind TokenKind -> TokenKind -> Bool
forall a. Eq a => a -> a -> Bool
== TokenKind
Mnemonic Bool -> Bool -> Bool
&& a
t a -> [a] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [a
"lit", a
"@p", a
"if", a
"-if", a
"next"]) [(TokenKind, a)]
ts

isNumber :: Text -> Bool
isNumber :: Text -> Bool
isNumber Text
w =
    let unsigned :: Text
unsigned = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
w (Text -> Text -> Maybe Text
T.stripPrefix Text
"-" Text
w)
     in case Text -> Text -> Maybe Text
T.stripPrefix Text
"0x" Text
unsigned of
            Just Text
ds -> (Char -> Bool) -> Text -> Bool
startsWith Char -> Bool
isHexDigit Text
ds Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all (\Char
c -> Char -> Bool
isHexDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') Text
ds
            Maybe Text
Nothing -> (Char -> Bool) -> Text -> Bool
startsWith Char -> Bool
isDigit Text
unsigned Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all (\Char
c -> Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') Text
unsigned
    where
        startsWith :: (Char -> Bool) -> Text -> Bool
startsWith Char -> Bool
p Text
t = Bool -> ((Char, Text) -> Bool) -> Maybe (Char, Text) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Char -> Bool
p (Char -> Bool) -> ((Char, Text) -> Char) -> (Char, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char, Text) -> Char
forall a b. (a, b) -> a
fst) (Text -> Maybe (Char, Text)
T.uncons Text
t)

isRegister :: Isa -> Text -> Bool
isRegister :: Isa -> Text -> Bool
isRegister Isa
isa Text
w = case Isa
isa of
    Isa
RiscIv -> Text
w Text -> [Text] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [Text]
riscRegisters
    Isa
VliwIv -> Text
w Text -> [Text] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [Text]
riscRegisters
    Isa
M68k -> case Text -> String
forall a. ToString a => a -> String
toString Text
w of
        [Char
r, Char
n] -> Char
r Char -> String -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` (String
"AD" :: String) Bool -> Bool -> Bool
&& Char
n Char -> String -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [Char
'0' .. Char
'7']
        String
_ -> Bool
False
    Isa
_ -> Bool
False

riscRegisters :: [Text]
riscRegisters :: [Text]
riscRegisters =
    [Text
"zero", Text
"ra", Text
"sp", Text
"gp", Text
"tp", Text
"fp"]
        [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Text -> Int -> [Text]
forall {b}. (Semigroup b, IsString b) => b -> Int -> [b]
numbered Text
"t" Int
6
        [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Text -> Int -> [Text]
forall {b}. (Semigroup b, IsString b) => b -> Int -> [b]
numbered Text
"s" Int
11
        [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Text -> Int -> [Text]
forall {b}. (Semigroup b, IsString b) => b -> Int -> [b]
numbered Text
"a" Int
7
    where
        numbered :: b -> Int -> [b]
numbered b
p Int
n = (Int -> b) -> [Int] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map ((b
p b -> b -> b
forall a. Semigroup a => a -> a -> a
<>) (b -> b) -> (Int -> b) -> Int -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> b
forall b a. (Show a, IsString b) => a -> b
show) [Int
0 .. Int
n :: Int]

-- | Tokens for simulation log, memory dump and statistics lines.
tokenizeReportLine :: Isa -> Text -> [(TokenKind, Text)]
tokenizeReportLine :: Isa -> Text -> [(TokenKind, Text)]
tokenizeReportLine Isa
isa Text
line
    | Text
"#" Text -> Text -> Bool
`T.isPrefixOf` Text
line = [(TokenKind
Directive, Text
line)]
    | Text -> Text
T.strip Text
line Text -> [Text] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [Text
"---", Text
"```"] = [(TokenKind
Separator, Text
line)]
    | Just (Text
prefix, Text
rest) <- Text -> Maybe (Text, Text)
linePrefix Text
line =
        if Text -> Bool
isNumber (Int -> Text -> Text
T.dropEnd Int
1 Text
prefix) Bool -> Bool -> Bool
|| Text
"mem[" Text -> Text -> Bool
`T.isPrefixOf` Text
prefix
            then (TokenKind
Separator, Text
prefix) (TokenKind, Text) -> [(TokenKind, Text)] -> [(TokenKind, Text)]
forall a. a -> [a] -> [a]
: Text -> [(TokenKind, Text)]
addressed Text
rest
            else (TokenKind
Ref, Text
prefix) (TokenKind, Text) -> [(TokenKind, Text)] -> [(TokenKind, Text)]
forall a. a -> [a] -> [a]
: Isa -> String -> [(TokenKind, Text)]
reportBody Isa
isa (Text -> String
forall a. ToString a => a -> String
toString Text
rest)
    | Bool
otherwise = Isa -> String -> [(TokenKind, Text)]
reportBody Isa
isa (Text -> String
forall a. ToString a => a -> String
toString Text
line)
    where
        addressed :: Text -> [(TokenKind, Text)]
addressed Text
rest = case Text -> [Text]
T.words Text
rest of
            [Text
name]
                | Bool -> Bool
not (Text -> Bool
isNumber Text
name)
                , Bool -> ((Char, Text) -> Bool) -> Maybe (Char, Text) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((\Char
c -> Char -> Bool
isLower Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') (Char -> Bool) -> ((Char, Text) -> Char) -> (Char, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char, Text) -> Char
forall a b. (a, b) -> a
fst) (Text -> Maybe (Char, Text)
T.uncons Text
name) ->
                    let (Text
sp, Text
w) = (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
isSpace Text
rest in [(TokenKind
Plain, Text
sp), (TokenKind
Label, Text
w)]
            [Text]
_ -> Isa -> String -> [(TokenKind, Text)]
reportBody Isa
isa (Text -> String
forall a. ToString a => a -> String
toString Text
rest)

linePrefix :: Text -> Maybe (Text, Text)
linePrefix :: Text -> Maybe (Text, Text)
linePrefix Text
line =
    let (Text
before, Text
after) = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
": " (HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
":\t" Text
": " Text
line)
        prefix :: Text
prefix = Int -> Text -> Text
T.take (Text -> Int
T.length Text
before Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
line
     in if Text -> Bool
T.null Text
after Bool -> Bool -> Bool
|| Text -> Bool
T.null Text
before Bool -> Bool -> Bool
|| ((Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isSpace Text
before Bool -> Bool -> Bool
&& Bool -> Bool
not (Text
"mem[" Text -> Text -> Bool
`T.isPrefixOf` Text
before))
            then Maybe (Text, Text)
forall a. Maybe a
Nothing
            else (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
prefix, Int -> Text -> Text
T.drop (Text -> Int
T.length Text
prefix) Text
line)

reportBody :: Isa -> String -> [(TokenKind, Text)]
reportBody :: Isa -> String -> [(TokenKind, Text)]
reportBody Isa
_ [] = []
reportBody Isa
isa s :: String
s@(Char
x : String
xs)
    | Char -> Bool
isSpace Char
x = let (String
sp, String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isSpace String
s in (TokenKind
Plain, String -> Text
forall a. ToText a => a -> Text
toText String
sp) (TokenKind, Text) -> [(TokenKind, Text)] -> [(TokenKind, Text)]
forall a. a -> [a] -> [a]
: Isa -> String -> [(TokenKind, Text)]
reportBody Isa
isa String
rest
    | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' = let (String
str, String
rest) = Char -> String -> (String, String)
quoted Char
x String
xs in (TokenKind
Literal, String -> Text
forall a. ToText a => a -> Text
toText (Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
str)) (TokenKind, Text) -> [(TokenKind, Text)] -> [(TokenKind, Text)]
forall a. a -> [a] -> [a]
: Isa -> String -> [(TokenKind, Text)]
reportBody Isa
isa String
rest
    | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@', Char
'"' : String
ys <- String
xs = let (String
str, String
rest) = Char -> String -> (String, String)
quoted Char
'"' String
ys in (TokenKind
Label, String -> Text
forall a. ToText a => a -> Text
toText (Char
'@' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'"' Char -> ShowS
forall a. a -> [a] -> [a]
: String
str)) (TokenKind, Text) -> [(TokenKind, Text)] -> [(TokenKind, Text)]
forall a. a -> [a] -> [a]
: Isa -> String -> [(TokenKind, Text)]
reportBody Isa
isa String
rest
    | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@', (w :: String
w@(Char
_ : String
_), String
rest) <- (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isWordChar String
xs = (TokenKind
Label, String -> Text
forall a. ToText a => a -> Text
toText (Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
w)) (TokenKind, Text) -> [(TokenKind, Text)] -> [(TokenKind, Text)]
forall a. a -> [a] -> [a]
: Isa -> String -> [(TokenKind, Text)]
reportBody Isa
isa String
rest
    | Char -> Bool
isAlphaNum Char
x Bool -> Bool -> Bool
|| (Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
&& Bool -> (Char -> Bool) -> Maybe Char -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Char -> Bool
isDigit ((NonEmpty Char -> Char) -> String -> Maybe Char
forall a b. (NonEmpty a -> b) -> [a] -> Maybe b
viaNonEmpty NonEmpty Char -> Char
forall (f :: * -> *) a. IsNonEmpty f a a "head" => f a -> a
head String
xs)) =
        let (String
w, String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') String
xs
         in (Isa -> Text -> TokenKind
reportWord Isa
isa (String -> Text
forall a. ToText a => a -> Text
toText (Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
w)), String -> Text
forall a. ToText a => a -> Text
toText (Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
w)) (TokenKind, Text) -> [(TokenKind, Text)] -> [(TokenKind, Text)]
forall a. a -> [a] -> [a]
: Isa -> String -> [(TokenKind, Text)]
reportBody Isa
isa String
rest
    | Bool
otherwise = (TokenKind
Plain, OneItem Text -> Text
forall x. One x => OneItem x -> x
one Char
OneItem Text
x) (TokenKind, Text) -> [(TokenKind, Text)] -> [(TokenKind, Text)]
forall a. a -> [a] -> [a]
: Isa -> String -> [(TokenKind, Text)]
reportBody Isa
isa String
xs

reportWord :: Isa -> Text -> TokenKind
reportWord :: Isa -> Text -> TokenKind
reportWord Isa
isa Text
w
    | Text -> Bool
isNumber Text
w Bool -> Bool -> Bool
|| (Text -> Int
T.length Text
w Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all (\Char
c -> Char -> Bool
isHexDigit Char
c Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isUpper Char
c)) Text
w) = TokenKind
Literal
    | Text
w Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"B" = TokenKind
Plain
    | Bool -> ((Char, Text) -> Bool) -> Maybe (Char, Text) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Char -> Bool
isUpper (Char -> Bool) -> ((Char, Text) -> Char) -> (Char, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char, Text) -> Char
forall a b. (a, b) -> a
fst) (Text -> Maybe (Char, Text)
T.uncons Text
w) =
        if Isa -> Text -> Bool
isRegister Isa
isa Text
w Bool -> Bool -> Bool
|| Isa -> Text -> Bool
isRegister Isa
isa (Text -> Text
T.toLower Text
w) Bool -> Bool -> Bool
|| (Isa
isa Isa -> [Isa] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [Isa
RiscIv, Isa
VliwIv] Bool -> Bool -> Bool
&& Text
w Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"S0Fp")
            then TokenKind
Register
            else TokenKind
Mnemonic
    | Bool
otherwise = TokenKind
Plain