-- SPDX-FileCopyrightText: 2025 Sören Tempel <soeren+git@soeren-tempel.net>
--
-- SPDX-License-Identifier: GPL-3.0-only

module Language.QBE.Util where

import Data.Word (Word64)
import Language.QBE.Numbers
  ( decimal,
    fractExponent,
    hexnum,
    octnum,
    sign,
    signMinus,
  )
import Text.ParserCombinators.Parsec
  ( Parser,
    char,
    oneOf,
    skipMany,
    string,
    (<|>),
  )

bind :: String -> a -> Parser a
bind :: forall a. String -> a -> Parser a
bind String
str a
val = a
val a
-> ParsecT String () Identity String
-> ParsecT String () Identity a
forall a b.
a -> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
str

decNumber :: Parser Word64
decNumber :: Parser Word64
decNumber = do
  Word64 -> Word64
s <- ParsecT String () Identity (Word64 -> Word64)
forall a s (m :: * -> *) u.
(Num a, Stream s m Char) =>
ParsecT s u m (a -> a)
signMinus
  Word64 -> Word64
s (Word64 -> Word64) -> Parser Word64 -> Parser Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word64
forall i s (m :: * -> *) u.
(Integral i, Stream s m Char) =>
ParsecT s u m i
decimal

octNumber :: Parser Word64
octNumber :: Parser Word64
octNumber = do
  Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'0' ParsecT String () Identity Char -> Parser Word64 -> Parser Word64
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Word64
forall i s (m :: * -> *) u.
(Integral i, Stream s m Char) =>
ParsecT s u m i
octnum

-- A float parser that tries to be compatible with strtod(3).
float :: (Floating f, Read f) => Parser f
float :: forall f. (Floating f, Read f) => Parser f
float = do
  ()
_ <- Parser ()
skipSpace
  Integer -> Integer
s <- ParsecT String () Identity (Integer -> Integer)
forall a s (m :: * -> *) u.
(Num a, Stream s m Char) =>
ParsecT s u m (a -> a)
sign
  -- TODO: Support infininty and NaN
  (ParsecT String () Identity Integer
forall i s (m :: * -> *) u.
(Integral i, Stream s m Char) =>
ParsecT s u m i
decimal ParsecT String () Identity Integer
-> ParsecT String () Identity Integer
-> ParsecT String () Identity Integer
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Integer
forall i s (m :: * -> *) u.
(Integral i, Stream s m Char) =>
ParsecT s u m i
hexnum) ParsecT String () Identity Integer
-> (Integer -> Parser f) -> Parser f
forall a b.
ParsecT String () Identity a
-> (a -> ParsecT String () Identity b)
-> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Integer -> Parser f
forall f s (m :: * -> *) u.
(Floating f, Stream s m Char) =>
Integer -> ParsecT s u m f
fractExponent (Integer -> Parser f)
-> (Integer -> Integer) -> Integer -> Parser f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
s
  where
    -- See musl's isspace(3) implementation.
    skipSpace :: Parser ()
    skipSpace :: Parser ()
skipSpace = ParsecT String () Identity Char -> Parser ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (ParsecT String () Identity Char -> Parser ())
-> ParsecT String () Identity Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
" \t\n\v\f\r"