{-# LANGUAGE LambdaCase #-} module Jikka.Common.Name where import Data.List import Data.Maybe import Text.Read type OccName = Maybe String type NameFlavour = Maybe Int toFlavouredName :: String -> (OccName, NameFlavour) toFlavouredName :: String -> (OccName, NameFlavour) toFlavouredName = \case String "_" -> (OccName forall a. Maybe a Nothing, NameFlavour forall a. Maybe a Nothing) String s -> case Char -> String -> NameFlavour forall a. Eq a => a -> [a] -> NameFlavour elemIndex Char '$' String s of NameFlavour Nothing -> (String -> OccName forall a. a -> Maybe a Just String s, NameFlavour forall a. Maybe a Nothing) Just Int i -> let (String occ, String flavour) = Int -> String -> (String, String) forall a. Int -> [a] -> ([a], [a]) splitAt Int i String s occ' :: OccName occ' = if String occ String -> String -> Bool forall a. Eq a => a -> a -> Bool == String "" then OccName forall a. Maybe a Nothing else String -> OccName forall a. a -> Maybe a Just String occ flavour' :: Int flavour' = case String -> NameFlavour forall a. Read a => String -> Maybe a readMaybe (String -> String forall a. [a] -> [a] tail String flavour) of NameFlavour Nothing -> String -> Int forall a. HasCallStack => String -> a error (String -> Int) -> String -> Int forall a b. (a -> b) -> a -> b $ String "Jikka.Common.Name.toFlavouredName: invalid flavoured name: " String -> String -> String forall a. [a] -> [a] -> [a] ++ String s Just Int i -> Int i in (OccName occ', Int -> NameFlavour forall a. a -> Maybe a Just Int flavour') formatFlavouredName :: OccName -> NameFlavour -> String formatFlavouredName :: OccName -> NameFlavour -> String formatFlavouredName OccName occ NameFlavour flavour = case (OccName occ, NameFlavour flavour) of (OccName Nothing, NameFlavour Nothing) -> String "_" (OccName, NameFlavour) _ -> String -> OccName -> String forall a. a -> Maybe a -> a fromMaybe String "" OccName occ String -> String -> String forall a. [a] -> [a] -> [a] ++ String -> (Int -> String) -> NameFlavour -> String forall b a. b -> (a -> b) -> Maybe a -> b maybe String "" ((Char '$' Char -> String -> String forall a. a -> [a] -> [a] :) (String -> String) -> (Int -> String) -> Int -> String forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> String forall a. Show a => a -> String show) NameFlavour flavour data NameHint = LocalNameHint | LocalArgumentNameHint | LoopCounterNameHint | ConstantNameHint | FunctionNameHint | ArgumentNameHint | AdHocNameHint String deriving (NameHint -> NameHint -> Bool (NameHint -> NameHint -> Bool) -> (NameHint -> NameHint -> Bool) -> Eq NameHint forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: NameHint -> NameHint -> Bool $c/= :: NameHint -> NameHint -> Bool == :: NameHint -> NameHint -> Bool $c== :: NameHint -> NameHint -> Bool Eq, Eq NameHint Eq NameHint -> (NameHint -> NameHint -> Ordering) -> (NameHint -> NameHint -> Bool) -> (NameHint -> NameHint -> Bool) -> (NameHint -> NameHint -> Bool) -> (NameHint -> NameHint -> Bool) -> (NameHint -> NameHint -> NameHint) -> (NameHint -> NameHint -> NameHint) -> Ord NameHint NameHint -> NameHint -> Bool NameHint -> NameHint -> Ordering NameHint -> NameHint -> NameHint forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a min :: NameHint -> NameHint -> NameHint $cmin :: NameHint -> NameHint -> NameHint max :: NameHint -> NameHint -> NameHint $cmax :: NameHint -> NameHint -> NameHint >= :: NameHint -> NameHint -> Bool $c>= :: NameHint -> NameHint -> Bool > :: NameHint -> NameHint -> Bool $c> :: NameHint -> NameHint -> Bool <= :: NameHint -> NameHint -> Bool $c<= :: NameHint -> NameHint -> Bool < :: NameHint -> NameHint -> Bool $c< :: NameHint -> NameHint -> Bool compare :: NameHint -> NameHint -> Ordering $ccompare :: NameHint -> NameHint -> Ordering $cp1Ord :: Eq NameHint Ord, Int -> NameHint -> String -> String [NameHint] -> String -> String NameHint -> String (Int -> NameHint -> String -> String) -> (NameHint -> String) -> ([NameHint] -> String -> String) -> Show NameHint forall a. (Int -> a -> String -> String) -> (a -> String) -> ([a] -> String -> String) -> Show a showList :: [NameHint] -> String -> String $cshowList :: [NameHint] -> String -> String show :: NameHint -> String $cshow :: NameHint -> String showsPrec :: Int -> NameHint -> String -> String $cshowsPrec :: Int -> NameHint -> String -> String Show, ReadPrec [NameHint] ReadPrec NameHint Int -> ReadS NameHint ReadS [NameHint] (Int -> ReadS NameHint) -> ReadS [NameHint] -> ReadPrec NameHint -> ReadPrec [NameHint] -> Read NameHint forall a. (Int -> ReadS a) -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a readListPrec :: ReadPrec [NameHint] $creadListPrec :: ReadPrec [NameHint] readPrec :: ReadPrec NameHint $creadPrec :: ReadPrec NameHint readList :: ReadS [NameHint] $creadList :: ReadS [NameHint] readsPrec :: Int -> ReadS NameHint $creadsPrec :: Int -> ReadS NameHint Read)