{- -----------------------------------------------------------------------------
Copyright 2019-2023 Kevin P. Barry

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
----------------------------------------------------------------------------- -}

-- Author: Kevin P. Barry [ta0kira@gmail.com]

{-# LANGUAGE Safe #-}

module CompilerCxx.Code (
  categoryBase,
  captureCreationTrace,
  clearCompiled,
  emptyCode,
  escapeChar,
  escapeChars,
  expressionFromLiteral,
  functionLabelType,
  hasPrimitiveValue,
  indentCompiled,
  isStoredUnboxed,
  newFunctionLabel,
  noTestsOnlySourceGuard,
  onlyCode,
  onlyCodes,
  onlyDeps,
  paramType,
  predTraceContext,
  readStoredVariable,
  setTraceContext,
  showCreationTrace,
  startCleanupTracing,
  startFunctionTracing,
  startInitTracing,
  startMainTracing,
  startTestTracing,
  testsOnlyCategoryGuard,
  testsOnlySourceGuard,
  typeBase,
  useAsArgs,
  useAsReturns,
  useAsUnboxed,
  useAsUnwrapped,
  useAsWhatever,
  valueAsUnwrapped,
  valueAsWrapped,
  valueBase,
  variableLazyType,
  variableProxyType,
  variableStoredType,
  writeStoredVariable,
) where

import Data.Char
import Data.List (intercalate)
import qualified Data.Set as Set

import Base.Positional
import Compilation.CompilerState
import CompilerCxx.Naming
import Types.Builtin
import Types.Procedure (ExpressionType)
import Types.TypeCategory
import Types.TypeInstance


emptyCode :: CompiledData [String]
emptyCode :: CompiledData [String]
emptyCode = [String] -> CompiledData [String]
onlyCodes []

onlyCode :: String -> CompiledData [String]
onlyCode :: String -> CompiledData [String]
onlyCode = [String] -> CompiledData [String]
onlyCodes forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[])

onlyCodes :: [String] -> CompiledData [String]
onlyCodes :: [String] -> CompiledData [String]
onlyCodes = forall s. Set CategoryName -> Set String -> s -> CompiledData s
CompiledData forall a. Set a
Set.empty forall a. Set a
Set.empty

onlyDeps :: Set.Set CategoryName -> CompiledData [String]
onlyDeps :: Set CategoryName -> CompiledData [String]
onlyDeps Set CategoryName
d = forall s. Set CategoryName -> Set String -> s -> CompiledData s
CompiledData Set CategoryName
d forall a. Set a
Set.empty []

indentCompiled :: CompiledData [String] -> CompiledData [String]
indentCompiled :: CompiledData [String] -> CompiledData [String]
indentCompiled (CompiledData Set CategoryName
r Set String
t [String]
o) = forall s. Set CategoryName -> Set String -> s -> CompiledData s
CompiledData Set CategoryName
r Set String
t forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (String
"  " forall a. [a] -> [a] -> [a]
++) [String]
o

clearCompiled :: CompiledData [String] -> CompiledData [String]
clearCompiled :: CompiledData [String] -> CompiledData [String]
clearCompiled (CompiledData Set CategoryName
r Set String
t [String]
_) = forall s. Set CategoryName -> Set String -> s -> CompiledData s
CompiledData Set CategoryName
r Set String
t []

startFunctionTracing :: CategoryName -> ScopedFunction c -> String
startFunctionTracing :: forall c. CategoryName -> ScopedFunction c -> String
startFunctionTracing CategoryName
t ScopedFunction c
f = String
"TRACE_FUNCTION(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall c. CategoryName -> ScopedFunction c -> String
functionDebugName CategoryName
t ScopedFunction c
f) forall a. [a] -> [a] -> [a]
++ String
")"

startMainTracing :: String -> String
startMainTracing :: String -> String
startMainTracing String
n = String
"TRACE_FUNCTION(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
n forall a. [a] -> [a] -> [a]
++ String
")"

startInitTracing :: CategoryName -> SymbolScope -> String
startInitTracing :: CategoryName -> SymbolScope -> String
startInitTracing CategoryName
t SymbolScope
s = String
"TRACE_FUNCTION(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Show a => a -> String
show CategoryName
t forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SymbolScope
s forall a. [a] -> [a] -> [a]
++ String
" init") forall a. [a] -> [a] -> [a]
++ String
")"

startTestTracing :: FunctionName -> String
startTestTracing :: FunctionName -> String
startTestTracing FunctionName
f = String
"TRACE_FUNCTION(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (String
"unittest " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show FunctionName
f) forall a. [a] -> [a] -> [a]
++ String
")"

startCleanupTracing :: String
startCleanupTracing :: String
startCleanupTracing = String
"TRACE_CLEANUP"

setTraceContext :: Show c => [c] -> [String]
setTraceContext :: forall c. Show c => [c] -> [String]
setTraceContext [c]
c
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [c]
c = []
  | Bool
otherwise = [String
"SET_CONTEXT_POINT(" forall a. [a] -> [a] -> [a]
++ String -> String
escapeChars (forall a. Show a => [a] -> String
formatFullContext [c]
c) forall a. [a] -> [a] -> [a]
++ String
")"]

predTraceContext :: Show c => [c] -> String
predTraceContext :: forall a. Show a => [a] -> String
predTraceContext [c]
c
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [c]
c = String
""
  | Bool
otherwise = String
"PRED_CONTEXT_POINT(" forall a. [a] -> [a] -> [a]
++ String -> String
escapeChars (forall a. Show a => [a] -> String
formatFullContext [c]
c) forall a. [a] -> [a] -> [a]
++ String
")"

captureCreationTrace :: CategoryName -> String
captureCreationTrace :: CategoryName -> String
captureCreationTrace CategoryName
n = String
"CAPTURE_CREATION(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. Show a => a -> String
show CategoryName
n) forall a. [a] -> [a] -> [a]
++ String
")"

showCreationTrace :: String
showCreationTrace :: String
showCreationTrace = String
"TRACE_CREATION"

hasPrimitiveValue :: CategoryName -> Bool
hasPrimitiveValue :: CategoryName -> Bool
hasPrimitiveValue CategoryName
BuiltinBool       = Bool
True
hasPrimitiveValue CategoryName
BuiltinInt        = Bool
True
hasPrimitiveValue CategoryName
BuiltinFloat      = Bool
True
hasPrimitiveValue CategoryName
BuiltinChar       = Bool
True
hasPrimitiveValue CategoryName
BuiltinPointer    = Bool
True
hasPrimitiveValue CategoryName
BuiltinIdentifier = Bool
True
hasPrimitiveValue CategoryName
_                 = Bool
False

isStoredUnboxed :: ValueType -> Bool
isStoredUnboxed :: ValueType -> Bool
isStoredUnboxed ValueType
t
  | ValueType
t forall a. Eq a => a -> a -> Bool
== ValueType
boolRequiredValue      = Bool
True
  | ValueType
t forall a. Eq a => a -> a -> Bool
== ValueType
intRequiredValue       = Bool
True
  | ValueType
t forall a. Eq a => a -> a -> Bool
== ValueType
floatRequiredValue     = Bool
True
  | ValueType
t forall a. Eq a => a -> a -> Bool
== ValueType
charRequiredValue      = Bool
True
  | ValueType -> Bool
isPointerRequiredValue ValueType
t    = Bool
True
  | ValueType -> Bool
isIdentifierRequiredValue ValueType
t = Bool
True
  | Bool
otherwise                   = Bool
False

expressionFromLiteral :: PrimitiveType -> String -> (ExpressionType,ExpressionValue)
expressionFromLiteral :: PrimitiveType -> String -> (ExpressionType, ExpressionValue)
expressionFromLiteral PrimitiveType
PrimString String
e =
  (forall a. [a] -> Positional a
Positional [ValueType
stringRequiredValue],PrimitiveType -> String -> ExpressionValue
UnboxedPrimitive PrimitiveType
PrimString forall a b. (a -> b) -> a -> b
$ String
"PrimString_FromLiteral(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")")
expressionFromLiteral PrimitiveType
PrimChar String
e =
  (forall a. [a] -> Positional a
Positional [ValueType
charRequiredValue],PrimitiveType -> String -> ExpressionValue
UnboxedPrimitive PrimitiveType
PrimChar forall a b. (a -> b) -> a -> b
$ String
"PrimChar(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")")
expressionFromLiteral PrimitiveType
PrimInt String
e =
  (forall a. [a] -> Positional a
Positional [ValueType
intRequiredValue],PrimitiveType -> String -> ExpressionValue
UnboxedPrimitive PrimitiveType
PrimInt forall a b. (a -> b) -> a -> b
$ String
"PrimInt(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")")
expressionFromLiteral PrimitiveType
PrimFloat String
e =
  (forall a. [a] -> Positional a
Positional [ValueType
floatRequiredValue],PrimitiveType -> String -> ExpressionValue
UnboxedPrimitive PrimitiveType
PrimFloat forall a b. (a -> b) -> a -> b
$ String
"PrimFloat(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")")
expressionFromLiteral PrimitiveType
PrimBool String
e =
  (forall a. [a] -> Positional a
Positional [ValueType
boolRequiredValue],PrimitiveType -> String -> ExpressionValue
UnboxedPrimitive PrimitiveType
PrimBool String
e)
expressionFromLiteral PrimitiveType
PrimPointer String
_ = forall a. HasCallStack => a
undefined
expressionFromLiteral PrimitiveType
PrimIdentifier String
_ = forall a. HasCallStack => a
undefined

getFromLazy :: ExpressionValue -> ExpressionValue
getFromLazy :: ExpressionValue -> ExpressionValue
getFromLazy (OpaqueMulti String
e)        = String -> ExpressionValue
OpaqueMulti forall a b. (a -> b) -> a -> b
$ String
"(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
").Get()"
getFromLazy (WrappedSingle String
e)      = String -> ExpressionValue
WrappedSingle forall a b. (a -> b) -> a -> b
$ String
"(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
").Get()"
getFromLazy (UnwrappedSingle String
e)    = String -> ExpressionValue
UnwrappedSingle forall a b. (a -> b) -> a -> b
$ String
"(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
").Get()"
getFromLazy (BoxedPrimitive PrimitiveType
t String
e)   = PrimitiveType -> String -> ExpressionValue
BoxedPrimitive PrimitiveType
t forall a b. (a -> b) -> a -> b
$ String
"(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
").Get()"
getFromLazy (UnboxedPrimitive PrimitiveType
t String
e) = PrimitiveType -> String -> ExpressionValue
UnboxedPrimitive PrimitiveType
t  forall a b. (a -> b) -> a -> b
$ String
"(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
").Get()"
getFromLazy (LazySingle ExpressionValue
e)         = ExpressionValue -> ExpressionValue
LazySingle forall a b. (a -> b) -> a -> b
$ ExpressionValue -> ExpressionValue
getFromLazy ExpressionValue
e

useAsWhatever :: ExpressionValue -> String
useAsWhatever :: ExpressionValue -> String
useAsWhatever (OpaqueMulti String
e)        = String
e
useAsWhatever (WrappedSingle String
e)      = String
e
useAsWhatever (UnwrappedSingle String
e)    = String
e
useAsWhatever (BoxedPrimitive PrimitiveType
_ String
e)   = String
e
useAsWhatever (UnboxedPrimitive PrimitiveType
_ String
e) = String
e
useAsWhatever (LazySingle ExpressionValue
e)         = ExpressionValue -> String
useAsWhatever forall a b. (a -> b) -> a -> b
$ ExpressionValue -> ExpressionValue
getFromLazy ExpressionValue
e

useAsReturns :: ExpressionValue -> String
useAsReturns :: ExpressionValue -> String
useAsReturns (OpaqueMulti String
e)                     = String
e
useAsReturns (WrappedSingle String
e)                   = String
"ReturnTuple(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
useAsReturns (UnwrappedSingle String
e)                 = String
"ReturnTuple(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
useAsReturns (BoxedPrimitive PrimitiveType
PrimBool String
e)         = String
"ReturnTuple(Box_Bool(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
"))"
useAsReturns (BoxedPrimitive PrimitiveType
PrimString String
e)       = String
"ReturnTuple(Box_String(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
"))"
useAsReturns (BoxedPrimitive PrimitiveType
PrimChar String
e)         = String
"ReturnTuple(Box_Char(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
"))"
useAsReturns (BoxedPrimitive PrimitiveType
PrimInt String
e)          = String
"ReturnTuple(Box_Int(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
"))"
useAsReturns (BoxedPrimitive PrimitiveType
PrimFloat String
e)        = String
"ReturnTuple(Box_Float(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
"))"
useAsReturns (BoxedPrimitive PrimitiveType
PrimPointer String
e)      = String
"ReturnTuple(Box_Pointer<void>(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
"))"
useAsReturns (BoxedPrimitive PrimitiveType
PrimIdentifier String
e)   = String
"ReturnTuple(Box_Identifier(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
"))"
useAsReturns (UnboxedPrimitive PrimitiveType
PrimBool String
e)       = String
"ReturnTuple(Box_Bool(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
"))"
useAsReturns (UnboxedPrimitive PrimitiveType
PrimString String
e)     = String
"ReturnTuple(Box_String(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
"))"
useAsReturns (UnboxedPrimitive PrimitiveType
PrimChar String
e)       = String
"ReturnTuple(Box_Char(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
"))"
useAsReturns (UnboxedPrimitive PrimitiveType
PrimInt String
e)        = String
"ReturnTuple(Box_Int(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
"))"
useAsReturns (UnboxedPrimitive PrimitiveType
PrimFloat String
e)      = String
"ReturnTuple(Box_Float(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
"))"
useAsReturns (UnboxedPrimitive PrimitiveType
PrimPointer String
e)    = String
"ReturnTuple(Box_Pointer<void>(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
"))"
useAsReturns (UnboxedPrimitive PrimitiveType
PrimIdentifier String
e) = String
"ReturnTuple(Box_Identifier(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
"))"
useAsReturns (LazySingle ExpressionValue
e)                      = ExpressionValue -> String
useAsReturns forall a b. (a -> b) -> a -> b
$ ExpressionValue -> ExpressionValue
getFromLazy ExpressionValue
e

useAsArgs :: ExpressionValue -> String
useAsArgs :: ExpressionValue -> String
useAsArgs (OpaqueMulti String
e)                     = String
e
useAsArgs (WrappedSingle String
e)                   = String
e
useAsArgs (UnwrappedSingle String
e)                 = String
e
useAsArgs (BoxedPrimitive PrimitiveType
PrimBool String
e)         = String
"Box_Bool(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
useAsArgs (BoxedPrimitive PrimitiveType
PrimString String
e)       = String
"Box_String(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
useAsArgs (BoxedPrimitive PrimitiveType
PrimChar String
e)         = String
"Box_Char(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
useAsArgs (BoxedPrimitive PrimitiveType
PrimInt String
e)          = String
"Box_Int(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
useAsArgs (BoxedPrimitive PrimitiveType
PrimFloat String
e)        = String
"Box_Float(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
useAsArgs (BoxedPrimitive PrimitiveType
PrimPointer String
e)      = String
"Box_Pointer<void>(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
useAsArgs (BoxedPrimitive PrimitiveType
PrimIdentifier String
e)   = String
"Box_Identifier(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
useAsArgs (UnboxedPrimitive PrimitiveType
PrimBool String
e)       = String
"Box_Bool(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
useAsArgs (UnboxedPrimitive PrimitiveType
PrimString String
e)     = String
"Box_String(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
useAsArgs (UnboxedPrimitive PrimitiveType
PrimChar String
e)       = String
"Box_Char(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
useAsArgs (UnboxedPrimitive PrimitiveType
PrimInt String
e)        = String
"Box_Int(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
useAsArgs (UnboxedPrimitive PrimitiveType
PrimFloat String
e)      = String
"Box_Float(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
useAsArgs (UnboxedPrimitive PrimitiveType
PrimPointer String
e)    = String
"Box_Pointer<void>(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
useAsArgs (UnboxedPrimitive PrimitiveType
PrimIdentifier String
e) = String
"Box_Identifier(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
useAsArgs (LazySingle ExpressionValue
e)                      = ExpressionValue -> String
useAsArgs forall a b. (a -> b) -> a -> b
$ ExpressionValue -> ExpressionValue
getFromLazy ExpressionValue
e

useAsUnwrapped :: ExpressionValue -> String
useAsUnwrapped :: ExpressionValue -> String
useAsUnwrapped (OpaqueMulti String
e)                     = String
"(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
").At(0)"
useAsUnwrapped (WrappedSingle String
e)                   = String
e
useAsUnwrapped (UnwrappedSingle String
e)                 = String
e
useAsUnwrapped (BoxedPrimitive PrimitiveType
PrimBool String
e)         = String
"Box_Bool(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
useAsUnwrapped (BoxedPrimitive PrimitiveType
PrimString String
e)       = String
"Box_String(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
useAsUnwrapped (BoxedPrimitive PrimitiveType
PrimChar String
e)         = String
"Box_Char(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
useAsUnwrapped (BoxedPrimitive PrimitiveType
PrimInt String
e)          = String
"Box_Int(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
useAsUnwrapped (BoxedPrimitive PrimitiveType
PrimFloat String
e)        = String
"Box_Float(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
useAsUnwrapped (BoxedPrimitive PrimitiveType
PrimPointer String
e)      = String
"Box_Pointer<void>(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
useAsUnwrapped (BoxedPrimitive PrimitiveType
PrimIdentifier String
e)   = String
"Box_Identifier(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
useAsUnwrapped (UnboxedPrimitive PrimitiveType
PrimBool String
e)       = String
"Box_Bool(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
useAsUnwrapped (UnboxedPrimitive PrimitiveType
PrimString String
e)     = String
"Box_String(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
useAsUnwrapped (UnboxedPrimitive PrimitiveType
PrimChar String
e)       = String
"Box_Char(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
useAsUnwrapped (UnboxedPrimitive PrimitiveType
PrimInt String
e)        = String
"Box_Int(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
useAsUnwrapped (UnboxedPrimitive PrimitiveType
PrimFloat String
e)      = String
"Box_Float(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
useAsUnwrapped (UnboxedPrimitive PrimitiveType
PrimPointer String
e)    = String
"Box_Pointer<void>(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
useAsUnwrapped (UnboxedPrimitive PrimitiveType
PrimIdentifier String
e) = String
"Box_Identifier(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
useAsUnwrapped (LazySingle ExpressionValue
e)                      = ExpressionValue -> String
useAsUnwrapped forall a b. (a -> b) -> a -> b
$ ExpressionValue -> ExpressionValue
getFromLazy ExpressionValue
e

useAsUnboxed :: PrimitiveType -> ExpressionValue -> String
useAsUnboxed :: PrimitiveType -> ExpressionValue -> String
useAsUnboxed PrimitiveType
PrimBool       (OpaqueMulti String
e)     = String
"(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
").At(0).AsBool()"
useAsUnboxed PrimitiveType
PrimString     (OpaqueMulti String
e)     = String
"(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
").At(0).AsString()"
useAsUnboxed PrimitiveType
PrimChar       (OpaqueMulti String
e)     = String
"(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
").At(0).AsChar()"
useAsUnboxed PrimitiveType
PrimInt        (OpaqueMulti String
e)     = String
"(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
").At(0).AsInt()"
useAsUnboxed PrimitiveType
PrimFloat      (OpaqueMulti String
e)     = String
"(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
").At(0).AsFloat()"
useAsUnboxed PrimitiveType
PrimPointer    (OpaqueMulti String
e)     = String
"(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
").At(0).AsPointer<OpaqueObject>()"
useAsUnboxed PrimitiveType
PrimIdentifier (OpaqueMulti String
e)     = String
"(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
").At(0).AsIdentifier()"
useAsUnboxed PrimitiveType
PrimBool       (WrappedSingle String
e)   = String
"(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
").AsBool()"
useAsUnboxed PrimitiveType
PrimString     (WrappedSingle String
e)   = String
"(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
").AsString()"
useAsUnboxed PrimitiveType
PrimChar       (WrappedSingle String
e)   = String
"(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
").AsChar()"
useAsUnboxed PrimitiveType
PrimInt        (WrappedSingle String
e)   = String
"(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
").AsInt()"
useAsUnboxed PrimitiveType
PrimFloat      (WrappedSingle String
e)   = String
"(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
").AsFloat()"
useAsUnboxed PrimitiveType
PrimPointer    (WrappedSingle String
e)   = String
"(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
").AsPointer<OpaqueObject>()"
useAsUnboxed PrimitiveType
PrimIdentifier (WrappedSingle String
e)   = String
"(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
").AsIdentifier()"
useAsUnboxed PrimitiveType
PrimBool       (UnwrappedSingle String
e) = String
"(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
").AsBool()"
useAsUnboxed PrimitiveType
PrimString     (UnwrappedSingle String
e) = String
"(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
").AsString()"
useAsUnboxed PrimitiveType
PrimChar       (UnwrappedSingle String
e) = String
"(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
").AsChar()"
useAsUnboxed PrimitiveType
PrimInt        (UnwrappedSingle String
e) = String
"(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
").AsInt()"
useAsUnboxed PrimitiveType
PrimFloat      (UnwrappedSingle String
e) = String
"(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
").AsFloat()"
useAsUnboxed PrimitiveType
PrimPointer    (UnwrappedSingle String
e) = String
"(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
").AsPointer<OpaqueObject>()"
useAsUnboxed PrimitiveType
PrimIdentifier (UnwrappedSingle String
e) = String
"(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
").AsIdentifier()"
useAsUnboxed PrimitiveType
_ (BoxedPrimitive PrimitiveType
_ String
e)             = String
e
useAsUnboxed PrimitiveType
_ (UnboxedPrimitive PrimitiveType
_ String
e)           = String
e
useAsUnboxed PrimitiveType
t (LazySingle ExpressionValue
e)                   = PrimitiveType -> ExpressionValue -> String
useAsUnboxed PrimitiveType
t forall a b. (a -> b) -> a -> b
$ ExpressionValue -> ExpressionValue
getFromLazy ExpressionValue
e

valueAsWrapped :: ExpressionValue -> ExpressionValue
valueAsWrapped :: ExpressionValue -> ExpressionValue
valueAsWrapped (UnwrappedSingle String
e)                 = String -> ExpressionValue
WrappedSingle String
e
valueAsWrapped (BoxedPrimitive PrimitiveType
_ String
e)                = String -> ExpressionValue
WrappedSingle String
e
valueAsWrapped (UnboxedPrimitive PrimitiveType
PrimBool String
e)       = String -> ExpressionValue
WrappedSingle forall a b. (a -> b) -> a -> b
$ String
"Box_Bool(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
valueAsWrapped (UnboxedPrimitive PrimitiveType
PrimString String
e)     = String -> ExpressionValue
WrappedSingle forall a b. (a -> b) -> a -> b
$ String
"Box_String(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
valueAsWrapped (UnboxedPrimitive PrimitiveType
PrimChar String
e)       = String -> ExpressionValue
WrappedSingle forall a b. (a -> b) -> a -> b
$ String
"Box_Char(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
valueAsWrapped (UnboxedPrimitive PrimitiveType
PrimInt String
e)        = String -> ExpressionValue
WrappedSingle forall a b. (a -> b) -> a -> b
$ String
"Box_Int(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
valueAsWrapped (UnboxedPrimitive PrimitiveType
PrimFloat String
e)      = String -> ExpressionValue
WrappedSingle forall a b. (a -> b) -> a -> b
$ String
"Box_Float(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
valueAsWrapped (UnboxedPrimitive PrimitiveType
PrimPointer String
e)    = String -> ExpressionValue
WrappedSingle forall a b. (a -> b) -> a -> b
$ String
"Box_Pointer<void>(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
valueAsWrapped (UnboxedPrimitive PrimitiveType
PrimIdentifier String
e) = String -> ExpressionValue
WrappedSingle forall a b. (a -> b) -> a -> b
$ String
"Box_Identifier(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
valueAsWrapped (LazySingle ExpressionValue
e)                      = ExpressionValue -> ExpressionValue
valueAsWrapped forall a b. (a -> b) -> a -> b
$ ExpressionValue -> ExpressionValue
getFromLazy ExpressionValue
e
valueAsWrapped ExpressionValue
v                                   = ExpressionValue
v

valueAsUnwrapped :: ExpressionValue -> ExpressionValue
valueAsUnwrapped :: ExpressionValue -> ExpressionValue
valueAsUnwrapped (OpaqueMulti String
e)                     = String -> ExpressionValue
UnwrappedSingle forall a b. (a -> b) -> a -> b
$ String
"(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
").At(0)"
valueAsUnwrapped (WrappedSingle String
e)                   = String -> ExpressionValue
UnwrappedSingle String
e
valueAsUnwrapped (UnboxedPrimitive PrimitiveType
PrimBool String
e)       = String -> ExpressionValue
UnwrappedSingle forall a b. (a -> b) -> a -> b
$ String
"Box_Bool(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
valueAsUnwrapped (UnboxedPrimitive PrimitiveType
PrimString String
e)     = String -> ExpressionValue
UnwrappedSingle forall a b. (a -> b) -> a -> b
$ String
"Box_String(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
valueAsUnwrapped (UnboxedPrimitive PrimitiveType
PrimChar String
e)       = String -> ExpressionValue
UnwrappedSingle forall a b. (a -> b) -> a -> b
$ String
"Box_Char(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
valueAsUnwrapped (UnboxedPrimitive PrimitiveType
PrimInt String
e)        = String -> ExpressionValue
UnwrappedSingle forall a b. (a -> b) -> a -> b
$ String
"Box_Int(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
valueAsUnwrapped (UnboxedPrimitive PrimitiveType
PrimFloat String
e)      = String -> ExpressionValue
UnwrappedSingle forall a b. (a -> b) -> a -> b
$ String
"Box_Float(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
valueAsUnwrapped (UnboxedPrimitive PrimitiveType
PrimPointer String
e)    = String -> ExpressionValue
UnwrappedSingle forall a b. (a -> b) -> a -> b
$ String
"Box_Pointer<void>(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
valueAsUnwrapped (UnboxedPrimitive PrimitiveType
PrimIdentifier String
e) = String -> ExpressionValue
UnwrappedSingle forall a b. (a -> b) -> a -> b
$ String
"Box_Identifier(" forall a. [a] -> [a] -> [a]
++ String
e forall a. [a] -> [a] -> [a]
++ String
")"
valueAsUnwrapped (LazySingle ExpressionValue
e)                      = ExpressionValue -> ExpressionValue
valueAsUnwrapped forall a b. (a -> b) -> a -> b
$ ExpressionValue -> ExpressionValue
getFromLazy ExpressionValue
e
valueAsUnwrapped ExpressionValue
v                                   = ExpressionValue
v

variableStoredType :: ValueType -> String
variableStoredType :: ValueType -> String
variableStoredType ValueType
t
  | ValueType
t forall a. Eq a => a -> a -> Bool
== ValueType
boolRequiredValue      = String
"PrimBool"
  | ValueType
t forall a. Eq a => a -> a -> Bool
== ValueType
intRequiredValue       = String
"PrimInt"
  | ValueType
t forall a. Eq a => a -> a -> Bool
== ValueType
floatRequiredValue     = String
"PrimFloat"
  | ValueType
t forall a. Eq a => a -> a -> Bool
== ValueType
charRequiredValue      = String
"PrimChar"
  | ValueType -> Bool
isPointerRequiredValue ValueType
t    = String
"PrimPointer"
  | ValueType -> Bool
isIdentifierRequiredValue ValueType
t = String
"PrimIdentifier"
  | ValueType -> Bool
isWeakValue ValueType
t               = String
"WeakValue"
  | Bool
otherwise                   = String
"BoxedValue"

variableLazyType :: ValueType -> String
variableLazyType :: ValueType -> String
variableLazyType ValueType
t = String
"LazyInit<" forall a. [a] -> [a] -> [a]
++ ValueType -> String
variableStoredType ValueType
t forall a. [a] -> [a] -> [a]
++ String
">"

variableProxyType :: ValueType -> String
variableProxyType :: ValueType -> String
variableProxyType ValueType
t
  | ValueType
t forall a. Eq a => a -> a -> Bool
== ValueType
boolRequiredValue      = String
"PrimBool"
  | ValueType
t forall a. Eq a => a -> a -> Bool
== ValueType
intRequiredValue       = String
"PrimInt"
  | ValueType
t forall a. Eq a => a -> a -> Bool
== ValueType
floatRequiredValue     = String
"PrimFloat"
  | ValueType
t forall a. Eq a => a -> a -> Bool
== ValueType
charRequiredValue      = String
"PrimChar"
  | ValueType -> Bool
isPointerRequiredValue ValueType
t    = String
"PrimPointer"
  | ValueType -> Bool
isIdentifierRequiredValue ValueType
t = String
"PrimIdentifier"
  | ValueType -> Bool
isWeakValue ValueType
t               = String
"WeakValue&"
  | Bool
otherwise                   = String
"BoxedValue&"

readStoredVariable :: Bool -> ValueType -> String -> ExpressionValue
readStoredVariable :: Bool -> ValueType -> String -> ExpressionValue
readStoredVariable Bool
True ValueType
t String
s = ExpressionValue -> ExpressionValue
LazySingle forall a b. (a -> b) -> a -> b
$ Bool -> ValueType -> String -> ExpressionValue
readStoredVariable Bool
False ValueType
t String
s
readStoredVariable Bool
False ValueType
t String
s
  | ValueType
t forall a. Eq a => a -> a -> Bool
== ValueType
boolRequiredValue      = PrimitiveType -> String -> ExpressionValue
UnboxedPrimitive PrimitiveType
PrimBool     String
s
  | ValueType
t forall a. Eq a => a -> a -> Bool
== ValueType
intRequiredValue       = PrimitiveType -> String -> ExpressionValue
UnboxedPrimitive PrimitiveType
PrimInt      String
s
  | ValueType
t forall a. Eq a => a -> a -> Bool
== ValueType
floatRequiredValue     = PrimitiveType -> String -> ExpressionValue
UnboxedPrimitive PrimitiveType
PrimFloat    String
s
  | ValueType
t forall a. Eq a => a -> a -> Bool
== ValueType
charRequiredValue      = PrimitiveType -> String -> ExpressionValue
UnboxedPrimitive PrimitiveType
PrimChar     String
s
  | ValueType -> Bool
isPointerRequiredValue ValueType
t    = PrimitiveType -> String -> ExpressionValue
UnboxedPrimitive PrimitiveType
PrimPointer  String
s
  | ValueType -> Bool
isIdentifierRequiredValue ValueType
t = PrimitiveType -> String -> ExpressionValue
UnboxedPrimitive PrimitiveType
PrimIdentifier String
s
  | Bool
otherwise                   = String -> ExpressionValue
UnwrappedSingle String
s

writeStoredVariable :: ValueType -> ExpressionValue -> String
writeStoredVariable :: ValueType -> ExpressionValue -> String
writeStoredVariable ValueType
t ExpressionValue
e
  | ValueType
t forall a. Eq a => a -> a -> Bool
== ValueType
boolRequiredValue      = PrimitiveType -> ExpressionValue -> String
useAsUnboxed PrimitiveType
PrimBool     ExpressionValue
e
  | ValueType
t forall a. Eq a => a -> a -> Bool
== ValueType
intRequiredValue       = PrimitiveType -> ExpressionValue -> String
useAsUnboxed PrimitiveType
PrimInt      ExpressionValue
e
  | ValueType
t forall a. Eq a => a -> a -> Bool
== ValueType
floatRequiredValue     = PrimitiveType -> ExpressionValue -> String
useAsUnboxed PrimitiveType
PrimFloat    ExpressionValue
e
  | ValueType
t forall a. Eq a => a -> a -> Bool
== ValueType
charRequiredValue      = PrimitiveType -> ExpressionValue -> String
useAsUnboxed PrimitiveType
PrimChar     ExpressionValue
e
  | ValueType -> Bool
isPointerRequiredValue ValueType
t    = PrimitiveType -> ExpressionValue -> String
useAsUnboxed PrimitiveType
PrimPointer  ExpressionValue
e
  | ValueType -> Bool
isIdentifierRequiredValue ValueType
t = PrimitiveType -> ExpressionValue -> String
useAsUnboxed PrimitiveType
PrimIdentifier ExpressionValue
e
  | Bool
otherwise                   = ExpressionValue -> String
useAsUnwrapped ExpressionValue
e

functionLabelType :: ScopedFunction c -> String
functionLabelType :: forall c. ScopedFunction c -> String
functionLabelType = SymbolScope -> String
getType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. ScopedFunction c -> SymbolScope
sfScope where
  getType :: SymbolScope -> String
getType SymbolScope
CategoryScope = String
"const CategoryFunction&"
  getType SymbolScope
TypeScope     = String
"const TypeFunction&"
  getType SymbolScope
ValueScope    = String
"const ValueFunction&"
  getType SymbolScope
_             = forall a. HasCallStack => a
undefined

newFunctionLabel :: Int -> ScopedFunction c -> String
newFunctionLabel :: forall c. Int -> ScopedFunction c -> String
newFunctionLabel Int
i ScopedFunction c
f = String
"(*new " forall a. [a] -> [a] -> [a]
++ (SymbolScope -> String
getType forall a b. (a -> b) -> a -> b
$ forall c. ScopedFunction c -> SymbolScope
sfScope ScopedFunction c
f) forall a. [a] -> [a] -> [a]
++ String
"{ " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
args forall a. [a] -> [a] -> [a]
++ String
" })" where
  args :: [String]
args = [
      String
paramCount,
      String
argCount,
      String
returnCount,
      String
category,
      String
function,
      String
collection,
      String
functionNum
    ]
  paramCount :: String
paramCount  = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. Positional a -> [a]
pValues forall a b. (a -> b) -> a -> b
$ forall c. ScopedFunction c -> Positional (ValueParam c)
sfParams ScopedFunction c
f
  argCount :: String
argCount    = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. Positional a -> [a]
pValues forall a b. (a -> b) -> a -> b
$ forall c.
ScopedFunction c
-> Positional (PassedValue c, Maybe (CallArgLabel c))
sfArgs ScopedFunction c
f
  returnCount :: String
returnCount = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. Positional a -> [a]
pValues forall a b. (a -> b) -> a -> b
$ forall c. ScopedFunction c -> Positional (PassedValue c)
sfReturns ScopedFunction c
f
  category :: String
category    = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall c. ScopedFunction c -> CategoryName
sfType ScopedFunction c
f
  function :: String
function    = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f
  collection :: String
collection  = CategoryName -> String
categoryIdName forall a b. (a -> b) -> a -> b
$ forall c. ScopedFunction c -> CategoryName
sfType ScopedFunction c
f
  functionNum :: String
functionNum = forall a. Show a => a -> String
show Int
i
  getType :: SymbolScope -> String
getType SymbolScope
CategoryScope = String
"CategoryFunction"
  getType SymbolScope
TypeScope     = String
"TypeFunction"
  getType SymbolScope
ValueScope    = String
"ValueFunction"
  getType SymbolScope
_             = forall a. HasCallStack => a
undefined

categoryBase :: String
categoryBase :: String
categoryBase = String
"TypeCategory"

typeBase :: String
typeBase :: String
typeBase = String
"TypeInstance"

valueBase :: String
valueBase :: String
valueBase = String
"TypeValue"

paramType :: String
paramType :: String
paramType = String
"const S<const " forall a. [a] -> [a] -> [a]
++ String
typeBase forall a. [a] -> [a] -> [a]
++ String
">"

unescapedChars :: Set.Set Char
unescapedChars :: Set Char
unescapedChars = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ [Char
'a'..Char
'z'] forall a. [a] -> [a] -> [a]
++ [Char
'A'..Char
'Z'] forall a. [a] -> [a] -> [a]
++ [Char
'0'..Char
'9'] forall a. [a] -> [a] -> [a]
++ [Char
' ',Char
'.']

escapeChar :: Char -> String
escapeChar :: Char -> String
escapeChar Char
c
  | Char
c forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Char
unescapedChars = [Char
c]
  | Bool
otherwise = [Char
'\\',Char
'x',Int -> Char
asHex Int
c1,Int -> Char
asHex Int
c2] where
    c1 :: Int
c1 = (Char -> Int
ord Char
c) forall a. Integral a => a -> a -> a
`div` Int
16
    c2 :: Int
c2 = (Char -> Int
ord Char
c) forall a. Integral a => a -> a -> a
`mod` Int
16
    asHex :: Int -> Char
asHex Int
n
      | Int
n forall a. Ord a => a -> a -> Bool
< Int
10    = Int -> Char
chr forall a b. (a -> b) -> a -> b
$ Int
n forall a. Num a => a -> a -> a
+ (Char -> Int
ord Char
'0')
      | Bool
otherwise = Int -> Char
chr forall a b. (a -> b) -> a -> b
$ Int
n forall a. Num a => a -> a -> a
+ (Char -> Int
ord Char
'A') forall a. Num a => a -> a -> a
- Int
10

escapeChars :: String -> String
escapeChars :: String -> String
escapeChars String
cs
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cs = String
"\"\""
  | Bool
otherwise = Bool -> String -> String -> String
escapeAll Bool
False String
"" String
cs where
    -- Creates alternating substrings of (un)escaped characters.
    escapeAll :: Bool -> String -> String -> String
escapeAll Bool
False String
ss (Char
c:String
cs2)
      | Char
c forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Char
unescapedChars = Bool -> String -> String -> String
escapeAll Bool
False (String
ss forall a. [a] -> [a] -> [a]
++ [Char
c]) String
cs2
      | Bool
otherwise = String -> String
maybeQuote String
ss forall a. [a] -> [a] -> [a]
++ Bool -> String -> String -> String
escapeAll Bool
True String
"" (Char
cforall a. a -> [a] -> [a]
:String
cs2)
    escapeAll Bool
True String
ss (Char
c:String
cs2)
      | Char
c forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Char
unescapedChars = String -> String
maybeQuote String
ss forall a. [a] -> [a] -> [a]
++ Bool -> String -> String -> String
escapeAll Bool
False String
"" (Char
cforall a. a -> [a] -> [a]
:String
cs2)
      | Bool
otherwise = Bool -> String -> String -> String
escapeAll Bool
True (String
ss forall a. [a] -> [a] -> [a]
++ Char -> String
escapeChar Char
c) String
cs2
    escapeAll Bool
_ String
ss String
"" = String -> String
maybeQuote String
ss
    maybeQuote :: String -> String
maybeQuote String
ss
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ss = String
""
      | Bool
otherwise = String
"\"" forall a. [a] -> [a] -> [a]
++ String
ss forall a. [a] -> [a] -> [a]
++ String
"\""

testsOnlyMacro :: String
testsOnlyMacro :: String
testsOnlyMacro = String
"ZEOLITE_TESTS_ONLY__YOUR_MODULE_IS_BROKEN_IF_YOU_USE_THIS_IN_HAND_WRITTEN_CODE"

noTestsOnlyMacro :: String
noTestsOnlyMacro :: String
noTestsOnlyMacro = String
"ZEOLITE_NO_TESTS_ONLY__YOUR_MODULE_IS_BROKEN_IF_YOU_USE_THIS_IN_HAND_WRITTEN_CODE"

testsOnlyCategoryGuard :: CategoryName -> [String]
testsOnlyCategoryGuard :: CategoryName -> [String]
testsOnlyCategoryGuard CategoryName
n = [
    String
"#ifndef " forall a. [a] -> [a] -> [a]
++ String
testsOnlyMacro,
    String
"#error Category " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CategoryName
n forall a. [a] -> [a] -> [a]
++ String
" can only be used by $TestsOnly$ categories",
    String
"#endif  // " forall a. [a] -> [a] -> [a]
++ String
testsOnlyMacro
  ]

testsOnlySourceGuard :: [String]
testsOnlySourceGuard :: [String]
testsOnlySourceGuard = [
    String
"#ifndef " forall a. [a] -> [a] -> [a]
++ String
testsOnlyMacro,
    String
"#define " forall a. [a] -> [a] -> [a]
++ String
testsOnlyMacro,
    String
"#endif  // " forall a. [a] -> [a] -> [a]
++ String
testsOnlyMacro,
    String
"#ifdef " forall a. [a] -> [a] -> [a]
++ String
noTestsOnlyMacro,
    String
"#error Cannot define both $TestsOnly$ and non-$TestsOnly$ categories in the same source file",
    String
"#endif  // " forall a. [a] -> [a] -> [a]
++ String
noTestsOnlyMacro
  ]

noTestsOnlySourceGuard :: [String]
noTestsOnlySourceGuard :: [String]
noTestsOnlySourceGuard = [
    String
"#ifndef " forall a. [a] -> [a] -> [a]
++ String
noTestsOnlyMacro,
    String
"#define " forall a. [a] -> [a] -> [a]
++ String
noTestsOnlyMacro,
    String
"#endif  // " forall a. [a] -> [a] -> [a]
++ String
noTestsOnlyMacro,
    String
"#ifdef " forall a. [a] -> [a] -> [a]
++ String
testsOnlyMacro,
    String
"#error Cannot define both $TestsOnly$ and non-$TestsOnly$ categories in the same source file",
    String
"#endif  // " forall a. [a] -> [a] -> [a]
++ String
testsOnlyMacro
  ]