module GHC.Toolchain.ParseTriple ( parseTriple ) where

import Data.List (isPrefixOf)

import GHC.Platform.ArchOS

import GHC.Toolchain.Prelude
import GHC.Toolchain.CheckArm
import GHC.Toolchain.Tools.Cc

-- | Parse a triple `arch-vendor-os` into an 'ArchOS' and a vendor name 'String'
--
-- If the user specified a duple (`arch-os`) instead, the vendor name is 'Nothing'
parseTriple :: Cc -> String -> M (ArchOS, Maybe String)
parseTriple :: Cc -> String -> M (ArchOS, Maybe String)
parseTriple Cc
cc String
triple
  | [String
archName, String
osName] <- [String]
parts
  = do arch <- Cc -> String -> M Arch
parseArch Cc
cc String
archName
       os   <- parseOs osName
       return (ArchOS arch os, Nothing)
  | [String
archName, String
vendorName, String
osName] <- [String]
parts
  = do arch <- Cc -> String -> M Arch
parseArch Cc
cc String
archName
       os   <- parseOs osName
       return (ArchOS arch os, Just (parseVendor vendorName))

  | [String
archName, String
vendorName, String
osName, String
_abi] <- [String]
parts
  = do arch <- Cc -> String -> M Arch
parseArch Cc
cc String
archName
       os   <- parseOs osName
       return (ArchOS arch os, Just (parseVendor vendorName))

  | Bool
otherwise
  = String -> M (ArchOS, Maybe String)
forall a. String -> M a
throwE (String -> M (ArchOS, Maybe String))
-> String -> M (ArchOS, Maybe String)
forall a b. (a -> b) -> a -> b
$ String
"malformed triple " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
triple
  where
    parts :: [String]
parts = Char -> String -> [String]
splitOn Char
'-' String
triple

parseArch :: Cc -> String -> M Arch
parseArch :: Cc -> String -> M Arch
parseArch Cc
cc String
arch =
    case String
arch of
      String
"i386" -> Arch -> M Arch
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Arch
ArchX86
      String
"x86_64" -> Arch -> M Arch
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Arch
ArchX86_64
      String
"amd64" -> Arch -> M Arch
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Arch
ArchX86_64
      String
"powerpc" -> Arch -> M Arch
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Arch
ArchPPC
      String
"powerpc64" -> Arch -> M Arch
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PPC_64ABI -> Arch
ArchPPC_64 PPC_64ABI
ELF_V1)
      String
"powerpc64le" -> Arch -> M Arch
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PPC_64ABI -> Arch
ArchPPC_64 PPC_64ABI
ELF_V2)
      String
"s390x" -> Arch -> M Arch
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Arch
ArchS390X
      String
"arm" -> Cc -> M Arch
findArmIsa Cc
cc
      String
_ | String
"armv" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
arch -> Cc -> M Arch
findArmIsa Cc
cc
      String
"arm64" -> Arch -> M Arch
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Arch
ArchAArch64
      String
"aarch64" -> Arch -> M Arch
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Arch
ArchAArch64
      String
"alpha" -> Arch -> M Arch
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Arch
ArchAlpha
      String
"mips" -> Arch -> M Arch
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Arch
ArchMipseb
      String
"mipseb" -> Arch -> M Arch
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Arch
ArchMipseb
      String
"mipsel" -> Arch -> M Arch
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Arch
ArchMipsel
      String
"riscv64" -> Arch -> M Arch
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Arch
ArchRISCV64
      String
"hppa" -> Arch -> M Arch
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Arch
ArchUnknown
      String
"wasm32" -> Arch -> M Arch
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Arch
ArchWasm32
      String
"javascript" -> Arch -> M Arch
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Arch
ArchJavaScript
      String
"loongarch64" -> Arch -> M Arch
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Arch
ArchLoongArch64
      String
_ -> String -> M Arch
forall a. String -> M a
throwE (String -> M Arch) -> String -> M Arch
forall a b. (a -> b) -> a -> b
$ String
"Unknown architecture " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
arch

parseOs :: String -> M OS
parseOs :: String -> M OS
parseOs String
os =
    case String
os of
      String
"linux" -> OS -> M OS
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OS
OSLinux
      String
"linux-android" -> OS -> M OS
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OS
OSLinux
      String
"darwin" -> OS -> M OS
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OS
OSDarwin
      String
"ios" -> OS -> M OS
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OS
OSDarwin
      String
"watchos" -> OS -> M OS
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OS
OSDarwin
      String
"tvos" -> OS -> M OS
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OS
OSDarwin
      String
"solaris2" -> OS -> M OS
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OS
OSSolaris2
      String
"mingw32" -> OS -> M OS
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OS
OSMinGW32
      String
"freebsd" -> OS -> M OS
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OS
OSFreeBSD
      String
"dragonfly" -> OS -> M OS
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OS
OSDragonFly
      String
"kfreebsdgnu" -> OS -> M OS
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OS
OSKFreeBSD
      String
"openbsd" -> OS -> M OS
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OS
OSOpenBSD
      String
"netbsd" -> OS -> M OS
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OS
OSNetBSD
      String
"haiku" -> OS -> M OS
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OS
OSHaiku
      String
"nto-qnc" -> OS -> M OS
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OS
OSQNXNTO
      String
"aix" -> OS -> M OS
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OS
OSAIX
      String
"gnu" -> OS -> M OS
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OS
OSHurd
      String
"wasi" -> OS -> M OS
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OS
OSWasi
      String
"ghcjs" -> OS -> M OS
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OS
OSGhcjs
      String
_ -> String -> M OS
forall a. String -> M a
throwE (String -> M OS) -> String -> M OS
forall a b. (a -> b) -> a -> b
$ String
"Unknown operating system " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
os

parseVendor :: String -> String
parseVendor :: String -> String
parseVendor String
vendor =
  case String
vendor of
    -- like i686-pc-linux-gnu, i686-gentoo-freebsd8, x86_64-w64-mingw32
    String
"pc" -> String
"unknown"
    String
"gentoo" -> String
"unknown"
    String
"w64" -> String
"unknown"
    -- like armv5tel-softfloat-linux-gnueabi
    String
"softfloat" -> String
"unknown"
    -- like armv7a-hardfloat-linux-gnueabi
    String
"hardfloat" -> String
"unknown"
    -- Pass through by default
    String
_ -> String
vendor

splitOn :: Char -> String -> [String]
splitOn :: Char -> String -> [String]
splitOn Char
sep = String -> [String]
go
  where
    go :: String -> [String]
go String
"" = []
    go String
s  = String
a String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
go (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
b)
      where
        (String
a,String
b) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
sep) String
s