{- |
Module      : Text.LLVM.Triple.Parse
Description : Parsing of LLVM target triples.
License     : BSD3
Maintainer  : Langston Barrett
Stability   : experimental

The declarations appear in this module in the same order as in the LLVM source.
-}

{- Note [Implementation]

The very simplest parsing functions are implemented with the 'LookupTable'
structure. For anything more complex, we endeavor to closely mirror the
structure of LLVM's implementation. This will make the code more maintainable
when updating to newer versions of LLVM.

-}

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}

module Text.LLVM.Triple.Parse
  ( parseArch
  , parseVendor
  , parseOS
  , parseEnv
  , parseObjFmt
  , parseSubArch
  , parseTriple
  ) where

import qualified Data.List as List

import qualified MonadLib as M
import qualified MonadLib.Monads as M

import Text.LLVM.Triple.AST
import qualified Text.LLVM.Triple.Print as Print
import Text.LLVM.Triple.Parse.LookupTable
import qualified Text.LLVM.Triple.Parse.ARM as ARM

-- | @llvm::parseArch@
--
-- https://github.com/llvm/llvm-project/blob/llvmorg-15.0.1/llvm/lib/Support/Triple.cpp#L442
parseArch :: String -> Arch
parseArch :: String -> Arch
parseArch String
s =
  let mArch :: Arch
mArch =
        -- See Note [Implementation] for the reasoning behind the strange structure.
        --
        -- It would be easy to forget to add patterns here when adding a new
        -- constructor to Arch, but we have exhaustive print-then-parse
        -- roundtrip tests to mitigate this risk.
        if | [String] -> Bool
cases [String
"i386", String
"i486", String
"i586", String
"i686"] -> Arch
X86
           | [String] -> Bool
cases [String
"i786", String
"i886", String
"i986"] -> Arch
X86
           | [String] -> Bool
cases [String
"amd64", String
"x86_64", String
"x86_64h"] -> Arch
X86_64
           | [String] -> Bool
cases [String
"powerpc", String
"powerpcspe", String
"ppc", String
"ppc32"] -> Arch
PPC
           | [String] -> Bool
cases [String
"powerpcle", String
"ppcle", String
"ppc32le"] -> Arch
PPCLE
           | [String] -> Bool
cases [String
"powerpc64", String
"ppu", String
"ppc64"] -> Arch
PPC64
           | [String] -> Bool
cases [String
"powerpc64le", String
"ppc64le"] -> Arch
PPC64LE
           | [String] -> Bool
cases [String
"xscale"] -> Arch
ARM
           | [String] -> Bool
cases [String
"xscaleeb"] -> Arch
ARMEB
           | [String] -> Bool
cases [String
"aarch64"] -> Arch
AArch64
           | [String] -> Bool
cases [String
"aarch64_be"] -> Arch
AArch64_BE
           | [String] -> Bool
cases [String
"aarch64_32"] -> Arch
AArch64_32
           | [String] -> Bool
cases [String
"arc"] -> Arch
ARC
           | [String] -> Bool
cases [String
"arm64"] -> Arch
AArch64
           | [String] -> Bool
cases [String
"arm64_32"] -> Arch
AArch64_32
           | [String] -> Bool
cases [String
"arm64e"] -> Arch
AArch64
           | [String] -> Bool
cases [String
"arm"] -> Arch
ARM
           | [String] -> Bool
cases [String
"armeb"] -> Arch
ARMEB
           | [String] -> Bool
cases [String
"thumb"] -> Arch
Thumb
           | [String] -> Bool
cases [String
"thumbeb"] -> Arch
ThumbEB
           | [String] -> Bool
cases [String
"avr"] -> Arch
AVR
           | [String] -> Bool
cases [String
"m68k"] -> Arch
M68k
           | [String] -> Bool
cases [String
"msp430"] -> Arch
MSP430
           | [String] -> Bool
cases [String
"mips", String
"mipseb", String
"mipsallegrex", String
"mipsisa32r6"
                   , String
"mipsr6"] -> Arch
MIPS
           | [String] -> Bool
cases [String
"mipsel", String
"mipsallegrexel", String
"mipsisa32r6el", String
"mipsr6el"] -> Arch
MIPSEL
           | [String] -> Bool
cases [String
"mips64", String
"mips64eb", String
"mipsn32", String
"mipsisa64r6"
                   , String
"mips64r6", String
"mipsn32r6"] -> Arch
MIPS64
           | [String] -> Bool
cases [String
"mips64el", String
"mipsn32el", String
"mipsisa64r6el", String
"mips64r6el"
                   , String
"mipsn32r6el"] -> Arch
MIPS64EL
           | [String] -> Bool
cases [String
"r600"] -> Arch
R600
           | [String] -> Bool
cases [String
"amdgcn"] -> Arch
AMDGCN
           | [String] -> Bool
cases [String
"riscv32"] -> Arch
RISCV32
           | [String] -> Bool
cases [String
"riscv64"] -> Arch
RISCV64
           | [String] -> Bool
cases [String
"hexagon"] -> Arch
Hexagon
           | [String] -> Bool
cases [String
"s390x", String
"systemz"] -> Arch
SystemZ
           | [String] -> Bool
cases [String
"sparc"] -> Arch
Sparc
           | [String] -> Bool
cases [String
"sparcel"] -> Arch
SparcEL
           | [String] -> Bool
cases [String
"sparcv9", String
"sparc64"] -> Arch
Sparcv9
           | [String] -> Bool
cases [String
"tce"] -> Arch
TCE
           | [String] -> Bool
cases [String
"tcele"] -> Arch
TCELE
           | [String] -> Bool
cases [String
"xcore"] -> Arch
XCore
           | [String] -> Bool
cases [String
"nvptx"] -> Arch
NVPTX
           | [String] -> Bool
cases [String
"nvptx64"] -> Arch
NVPTX64
           | [String] -> Bool
cases [String
"le32"] -> Arch
Le32
           | [String] -> Bool
cases [String
"le64"] -> Arch
Le64
           | [String] -> Bool
cases [String
"amdil"] -> Arch
AMDIL
           | [String] -> Bool
cases [String
"amdil64"] -> Arch
AMDIL64
           | [String] -> Bool
cases [String
"hsail"] -> Arch
HSAIL
           | [String] -> Bool
cases [String
"hsail64"] -> Arch
HSAIL64
           | [String] -> Bool
cases [String
"spir"] -> Arch
SPIR
           | [String] -> Bool
cases [String
"spir64"] -> Arch
SPIR64
           | [String] -> Bool
cases [String
"spirv32", String
"spirv32v1.0", String
"spirv32v1.1", String
"spirv32v1.2"
                   , String
"spirv32v1.3", String
"spirv32v1.4", String
"spirv32v1.5"] -> Arch
SPIRV32
           | [String] -> Bool
cases [String
"spirv64", String
"spirv64v1.0", String
"spirv64v1.1", String
"spirv64v1.2"
                   , String
"spirv64v1.3", String
"spirv64v1.4", String
"spirv64v1.5"] -> Arch
SPIRV64
           | Arch -> Bool
archPfx Arch
Kalimba -> Arch
Kalimba
           | [String] -> Bool
cases [String
"lanai"] -> Arch
Lanai
           | [String] -> Bool
cases [String
"renderscript32"] -> Arch
RenderScript32
           | [String] -> Bool
cases [String
"renderscript64"] -> Arch
RenderScript64
           | [String] -> Bool
cases [String
"shave"] -> Arch
SHAVE
           | [String] -> Bool
cases [String
"ve"] -> Arch
VE
           | [String] -> Bool
cases [String
"wasm32"] -> Arch
Wasm32
           | [String] -> Bool
cases [String
"wasm64"] -> Arch
Wasm64
           | [String] -> Bool
cases [String
"csky"] -> Arch
CSKY
           | [String] -> Bool
cases [String
"loongarch32"] -> Arch
LoongArch32
           | [String] -> Bool
cases [String
"loongarch64"] -> Arch
LoongArch64
           | [String] -> Bool
cases [String
"dxil"] -> Arch
DXIL
           | Bool
otherwise -> Arch
UnknownArch
  in case Arch
mArch of
        Arch
UnknownArch ->
          if | Arch -> Bool
archPfx Arch
ARM Bool -> Bool -> Bool
|| Arch -> Bool
archPfx Arch
Thumb Bool -> Bool -> Bool
|| Arch -> Bool
archPfx Arch
AArch64 ->
                 ArchName -> Arch
ARM.parseARMArch (String -> ArchName
ARM.ArchName String
s)
             | String
"bpf" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` String
s -> String -> Arch
parseBPFArch String
s
             | Bool
otherwise -> Arch
UnknownArch
        Arch
arch -> Arch
arch
  where
    cases :: [String] -> Bool
cases = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
s)
    archPfx :: Arch -> Bool
archPfx Arch
arch = Arch -> String
Print.archName Arch
arch String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` String
s

    -- https://github.com/llvm/llvm-project/blob/llvmorg-15.0.1/llvm/lib/Support/Triple.cpp#L292
    parseBPFArch :: String -> Arch
parseBPFArch String
arch =
      if String
arch String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bpf"
      -- The way that LLVM parses the arch for BPF depends on the endianness of
      -- the host in this case, which feels deeply wrong. We don't do that, not
      -- least since we're not in IO. We default to little-endian instead.
      then Arch
BPFEL
      else if | String
arch String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bpf_be" Bool -> Bool -> Bool
|| String
arch String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bpfeb" -> Arch
BPFEB
              | String
arch String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bpf_le" Bool -> Bool -> Bool
|| String
arch String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"bpfel" -> Arch
BPFEL
              | Bool
otherwise -> Arch
UnknownArch

-- | @llvm::parseVendor@
--
-- https://github.com/llvm/llvm-project/blob/llvmorg-15.0.1/llvm/lib/Support/Triple.cpp#L529
parseVendor :: String -> Vendor
parseVendor :: String -> Vendor
parseVendor = LookupTable Vendor -> Vendor -> String -> Vendor
forall a. LookupTable a -> a -> String -> a
lookupWithDefault LookupTable Vendor
table Vendor
UnknownVendor
  where table :: LookupTable Vendor
table = (Vendor -> String) -> LookupTable Vendor
forall a. (Bounded a, Enum a) => (a -> String) -> LookupTable a
enumTable Vendor -> String
Print.vendorName

-- | @llvm::parseOS@
--
-- https://github.com/llvm/llvm-project/blob/llvmorg-15.0.1/llvm/lib/Support/Triple.cpp#L549
parseOS :: String -> OS
parseOS :: String -> OS
parseOS = LookupTable OS -> OS -> String -> OS
forall a. LookupTable a -> a -> String -> a
lookupByPrefixWithDefault LookupTable OS
table OS
UnknownOS
  where table :: LookupTable OS
table = (OS -> String) -> LookupTable OS
forall a. (Bounded a, Enum a) => (a -> String) -> LookupTable a
enumTable OS -> String
Print.osName

-- | @llvm::parseEnvironment@
--
-- https://github.com/llvm/llvm-project/blob/llvmorg-15.0.1/llvm/lib/Support/Triple.cpp#L593
parseEnv :: String -> Environment
parseEnv :: String -> Environment
parseEnv = LookupTable Environment -> Environment -> String -> Environment
forall a. LookupTable a -> a -> String -> a
lookupByPrefixWithDefault LookupTable Environment
table Environment
UnknownEnvironment
  where table :: LookupTable Environment
table = (Environment -> String) -> LookupTable Environment
forall a. (Bounded a, Enum a) => (a -> String) -> LookupTable a
enumTable Environment -> String
Print.envName

-- | @llvm::parseFormat@
--
-- https://github.com/llvm/llvm-project/blob/llvmorg-15.0.1/llvm/lib/Support/Triple.cpp#L634
parseObjFmt :: String -> ObjectFormat
parseObjFmt :: String -> ObjectFormat
parseObjFmt = LookupTable ObjectFormat -> ObjectFormat -> String -> ObjectFormat
forall a. LookupTable a -> a -> String -> a
lookupBySuffixWithDefault LookupTable ObjectFormat
table ObjectFormat
UnknownObjectFormat
  where table :: LookupTable ObjectFormat
table = (ObjectFormat -> String) -> LookupTable ObjectFormat
forall a. (Bounded a, Enum a) => (a -> String) -> LookupTable a
enumTable ObjectFormat -> String
Print.objFmtName

-- | @llvm::parseSubArch@
--
-- https://github.com/llvm/llvm-project/blob/llvmorg-15.0.1/llvm/lib/Support/Triple.cpp#L648
parseSubArch :: String -> SubArch
parseSubArch :: String -> SubArch
parseSubArch String
subArchName =
  if | String -> Bool
startsWith String
"mips" Bool -> Bool -> Bool
&& (String -> Bool
endsWith String
"r6el" Bool -> Bool -> Bool
|| String -> Bool
endsWith String
"r6") -> SubArch
MipsSubArch_r6

     | String
subArchName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"powerpcspe" -> SubArch
PPCSubArch_spe

     | String
subArchName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"arm64e" -> SubArch
AArch64SubArch_arm64e

     | String -> Bool
startsWith String
"arm64e" -> SubArch
AArch64SubArch_arm64e

     | String -> Bool
startsWith String
"spirv" ->
         if | String -> Bool
endsWith String
"v1.0" -> SubArch
SPIRVSubArch_v10
            | String -> Bool
endsWith String
"v1.1" -> SubArch
SPIRVSubArch_v11
            | String -> Bool
endsWith String
"v1.2" -> SubArch
SPIRVSubArch_v12
            | String -> Bool
endsWith String
"v1.3" -> SubArch
SPIRVSubArch_v13
            | String -> Bool
endsWith String
"v1.4" -> SubArch
SPIRVSubArch_v14
            | String -> Bool
endsWith String
"v1.5" -> SubArch
SPIRVSubArch_v15
            | Bool
otherwise -> SubArch
NoSubArch
     | Bool
otherwise ->
         case ArchName -> ARMArch
ARM.parseArch (ArchName -> ARMArch) -> Maybe ArchName -> Maybe ARMArch
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ArchName
armSubArch of
           Maybe ARMArch
Nothing ->
             if | String -> Bool
endsWith String
"kalimba3" -> SubArch
KalimbaSubArch_v3
                | String -> Bool
endsWith String
"kalimba4" -> SubArch
KalimbaSubArch_v4
                | String -> Bool
endsWith String
"kalimba5" -> SubArch
KalimbaSubArch_v5
                | Bool
otherwise -> SubArch
NoSubArch
           Just ARMArch
armArch ->
             if | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV4 -> SubArch
NoSubArch
                | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV4T -> SubArch
ARMSubArch_v4t
                | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV5T -> SubArch
ARMSubArch_v5
                | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV5TE Bool -> Bool -> Bool
||
                  ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.IWMMXT Bool -> Bool -> Bool
||
                  ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.IWMMXT2 Bool -> Bool -> Bool
||
                  ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.XSCALE Bool -> Bool -> Bool
||
                  ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV5TEJ -> SubArch
ARMSubArch_v5te
                | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV6 ->  SubArch
ARMSubArch_v6
                | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV6K Bool -> Bool -> Bool
||
                  ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV6KZ -> SubArch
ARMSubArch_v6k
                | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV6T2 ->  SubArch
ARMSubArch_v6t2
                | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV6M ->  SubArch
ARMSubArch_v6m
                | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV7A Bool -> Bool -> Bool
||
                  ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV7R -> SubArch
ARMSubArch_v7
                | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV7VE -> SubArch
ARMSubArch_v7ve
                | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV7K -> SubArch
ARMSubArch_v7k
                | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV7M -> SubArch
ARMSubArch_v7m
                | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV7S -> SubArch
ARMSubArch_v7s
                | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV7EM -> SubArch
ARMSubArch_v7em
                | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV8A -> SubArch
ARMSubArch_v8
                | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV8_1A -> SubArch
ARMSubArch_v8_1a
                | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV8_2A -> SubArch
ARMSubArch_v8_2a
                | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV8_3A -> SubArch
ARMSubArch_v8_3a
                | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV8_4A -> SubArch
ARMSubArch_v8_4a
                | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV8_5A -> SubArch
ARMSubArch_v8_5a
                | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV8_6A -> SubArch
ARMSubArch_v8_6a
                | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV8_7A -> SubArch
ARMSubArch_v8_7a
                | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV8_8A -> SubArch
ARMSubArch_v8_8a
                | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV9A -> SubArch
ARMSubArch_v9
                | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV9_1A -> SubArch
ARMSubArch_v9_1a
                | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV9_2A -> SubArch
ARMSubArch_v9_2a
                | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV9_3A -> SubArch
ARMSubArch_v9_3a
                | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV8R -> SubArch
ARMSubArch_v8r
                | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV8MBaseline -> SubArch
ARMSubArch_v8m_baseline
                | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV8MMainline -> SubArch
ARMSubArch_v8m_mainline
                | ARMArch
armArch ARMArch -> ARMArch -> Bool
forall a. Eq a => a -> a -> Bool
== ARMArch
ARM.ARMV8_1MMainline -> SubArch
ARMSubArch_v8_1m_mainline
                | Bool
otherwise -> SubArch
NoSubArch
  where
    startsWith :: String -> Bool
startsWith = (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` String
subArchName)
    endsWith :: String -> Bool
endsWith = (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isSuffixOf` String
subArchName)
    armSubArch :: Maybe ArchName
armSubArch = ArchName -> Maybe ArchName
ARM.getCanonicalArchName (String -> ArchName
ARM.ArchName String
subArchName)

-- | @llvm::Triple::getDefaultFormat@
--
-- TODO(#97): Implement me!
defaultObjFmt :: TargetTriple -> ObjectFormat
defaultObjFmt :: TargetTriple -> ObjectFormat
defaultObjFmt TargetTriple
_tt = ObjectFormat
UnknownObjectFormat

-- | @llvm::Triple::Triple@
--
-- https://github.com/llvm/llvm-project/blob/llvmorg-15.0.1/llvm/lib/Support/Triple.cpp#L869
parseTriple :: String -> TargetTriple
parseTriple :: String -> TargetTriple
parseTriple String
str =
  [String] -> State [String] TargetTriple -> TargetTriple
forall {b} {c}. b -> State b c -> c
execState (Char -> String -> [String]
split Char
'-' String
str) (State [String] TargetTriple -> TargetTriple)
-> State [String] TargetTriple -> TargetTriple
forall a b. (a -> b) -> a -> b
$ do
    let pop :: a -> (t -> a) -> m a
pop a
def t -> a
f =
          ([t] -> (a, [t])) -> m a
forall (m :: * -> *) s a. StateM m s => (s -> (a, s)) -> m a
M.sets (([t] -> (a, [t])) -> m a) -> ([t] -> (a, [t])) -> m a
forall a b. (a -> b) -> a -> b
$
            \case
              (t
hd:[t]
rest) -> (t -> a
f t
hd, [t]
rest)
              [] -> (a
def, [])
    (Arch
arch, SubArch
subArch) <-
      (Arch, SubArch)
-> (String -> (Arch, SubArch)) -> State [String] (Arch, SubArch)
forall {m :: * -> *} {t} {a}. StateM m [t] => a -> (t -> a) -> m a
pop (Arch
UnknownArch, SubArch
NoSubArch) (\String
s -> (String -> Arch
parseArch String
s, String -> SubArch
parseSubArch String
s))
    Vendor
vendor <- Vendor -> (String -> Vendor) -> State [String] Vendor
forall {m :: * -> *} {t} {a}. StateM m [t] => a -> (t -> a) -> m a
pop Vendor
UnknownVendor String -> Vendor
parseVendor
    OS
os <- OS -> (String -> OS) -> State [String] OS
forall {m :: * -> *} {t} {a}. StateM m [t] => a -> (t -> a) -> m a
pop OS
UnknownOS String -> OS
parseOS
    (Environment
env, ObjectFormat
objFmt) <-
      (Environment, ObjectFormat)
-> (String -> (Environment, ObjectFormat))
-> State [String] (Environment, ObjectFormat)
forall {m :: * -> *} {t} {a}. StateM m [t] => a -> (t -> a) -> m a
pop (Environment
UnknownEnvironment, ObjectFormat
UnknownObjectFormat) (\String
s -> (String -> Environment
parseEnv String
s, String -> ObjectFormat
parseObjFmt String
s))
    let tt :: TargetTriple
tt =
          TargetTriple
          { ttArch :: Arch
ttArch = Arch
arch
          , ttSubArch :: SubArch
ttSubArch = SubArch
subArch
          , ttVendor :: Vendor
ttVendor = Vendor
vendor
          , ttOS :: OS
ttOS = OS
os
          , ttEnv :: Environment
ttEnv = Environment
env
          , ttObjFmt :: ObjectFormat
ttObjFmt = ObjectFormat
objFmt
          }
    TargetTriple -> State [String] TargetTriple
forall a. a -> State [String] a
forall (m :: * -> *) a. Monad m => a -> m a
return (TargetTriple
tt { ttObjFmt =
                   if ttObjFmt tt == UnknownObjectFormat
                   then defaultObjFmt tt
                   else ttObjFmt tt
               })
  where

    -- > split '-' "foo-bar" == ["foo", "bar"]
    split :: Char -> String -> [String]
    split :: Char -> String -> [String]
split Char
splitter =
      (Char -> [String] -> [String]) -> [String] -> String -> [String]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Char
c [String]
strs -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
splitter then ([]String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
strs) else Char -> [String] -> [String]
forall {a}. a -> [[a]] -> [[a]]
push Char
c [String]
strs) [[]]
      where
        push :: a -> [[a]] -> [[a]]
push a
c [] = [[a
c]]
        push a
c ([a]
s:[[a]]
strs) = (a
ca -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
s)[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
strs

    -- Not in MonadLib...
    execState :: b -> State b c -> c
execState b
s = (c, b) -> c
forall a b. (a, b) -> a
fst ((c, b) -> c) -> (State b c -> (c, b)) -> State b c -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> State b c -> (c, b)
forall i a. i -> State i a -> (a, i)
M.runState b
s