{- -----------------------------------------------------------------------------
Copyright 2019-2020 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 (
  ExprValue(..),
  PrimitiveType(..),
  categoryBase,
  captureCreationTrace,
  clearCompiled,
  emptyCode,
  escapeChar,
  escapeChars,
  functionLabelType,
  indentCompiled,
  isPrimType,
  newFunctionLabel,
  noTestsOnlySourceGuard,
  onlyCode,
  onlyCodes,
  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.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 ([String] -> CompiledData [String])
-> (String -> [String]) -> String -> CompiledData [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[])

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

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

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

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

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

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

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

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

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

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

captureCreationTrace :: String
captureCreationTrace :: String
captureCreationTrace = String
"CAPTURE_CREATION"

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

data PrimitiveType =
  PrimBool |
  PrimString |
  PrimChar |
  PrimInt |
  PrimFloat
  deriving (PrimitiveType -> PrimitiveType -> Bool
(PrimitiveType -> PrimitiveType -> Bool)
-> (PrimitiveType -> PrimitiveType -> Bool) -> Eq PrimitiveType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrimitiveType -> PrimitiveType -> Bool
$c/= :: PrimitiveType -> PrimitiveType -> Bool
== :: PrimitiveType -> PrimitiveType -> Bool
$c== :: PrimitiveType -> PrimitiveType -> Bool
Eq,Int -> PrimitiveType -> String -> String
[PrimitiveType] -> String -> String
PrimitiveType -> String
(Int -> PrimitiveType -> String -> String)
-> (PrimitiveType -> String)
-> ([PrimitiveType] -> String -> String)
-> Show PrimitiveType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PrimitiveType] -> String -> String
$cshowList :: [PrimitiveType] -> String -> String
show :: PrimitiveType -> String
$cshow :: PrimitiveType -> String
showsPrec :: Int -> PrimitiveType -> String -> String
$cshowsPrec :: Int -> PrimitiveType -> String -> String
Show)

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

data ExprValue =
  OpaqueMulti String |
  WrappedSingle String |
  UnwrappedSingle String |
  BoxedPrimitive PrimitiveType String |
  UnboxedPrimitive PrimitiveType String |
  LazySingle ExprValue
  deriving (Int -> ExprValue -> String -> String
[ExprValue] -> String -> String
ExprValue -> String
(Int -> ExprValue -> String -> String)
-> (ExprValue -> String)
-> ([ExprValue] -> String -> String)
-> Show ExprValue
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ExprValue] -> String -> String
$cshowList :: [ExprValue] -> String -> String
show :: ExprValue -> String
$cshow :: ExprValue -> String
showsPrec :: Int -> ExprValue -> String -> String
$cshowsPrec :: Int -> ExprValue -> String -> String
Show)

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

useAsWhatever :: ExprValue -> String
useAsWhatever :: ExprValue -> 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 ExprValue
e)         = ExprValue -> String
useAsWhatever (ExprValue -> String) -> ExprValue -> String
forall a b. (a -> b) -> a -> b
$ ExprValue -> ExprValue
getFromLazy ExprValue
e

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

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

useAsUnwrapped :: ExprValue -> String
useAsUnwrapped :: ExprValue -> String
useAsUnwrapped (OpaqueMulti String
e)                 = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
").Only()"
useAsUnwrapped (WrappedSingle String
e)               = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
useAsUnwrapped (UnwrappedSingle String
e)             = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
useAsUnwrapped (BoxedPrimitive PrimitiveType
PrimBool String
e)     = String
"Box_Bool(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
useAsUnwrapped (BoxedPrimitive PrimitiveType
PrimString String
e)   = String
"Box_String(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
useAsUnwrapped (BoxedPrimitive PrimitiveType
PrimChar String
e)     = String
"Box_Char(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
useAsUnwrapped (BoxedPrimitive PrimitiveType
PrimInt String
e)      = String
"Box_Int(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
useAsUnwrapped (BoxedPrimitive PrimitiveType
PrimFloat String
e)    = String
"Box_Float(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
useAsUnwrapped (UnboxedPrimitive PrimitiveType
PrimBool String
e)   = String
"Box_Bool(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
useAsUnwrapped (UnboxedPrimitive PrimitiveType
PrimString String
e) = String
"Box_String(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
useAsUnwrapped (UnboxedPrimitive PrimitiveType
PrimChar String
e) = String
"Box_Char(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
useAsUnwrapped (UnboxedPrimitive PrimitiveType
PrimInt String
e)    = String
"Box_Int(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
useAsUnwrapped (UnboxedPrimitive PrimitiveType
PrimFloat String
e)  = String
"Box_Float(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
useAsUnwrapped (LazySingle ExprValue
e)                  = ExprValue -> String
useAsUnwrapped (ExprValue -> String) -> ExprValue -> String
forall a b. (a -> b) -> a -> b
$ ExprValue -> ExprValue
getFromLazy ExprValue
e

useAsUnboxed :: PrimitiveType -> ExprValue -> String
useAsUnboxed :: PrimitiveType -> ExprValue -> String
useAsUnboxed PrimitiveType
PrimBool   (OpaqueMulti String
e) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
").Only()->AsBool()"
useAsUnboxed PrimitiveType
PrimString (OpaqueMulti String
e) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
").Only()->AsString()"
useAsUnboxed PrimitiveType
PrimChar   (OpaqueMulti String
e) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
").Only()->AsChar()"
useAsUnboxed PrimitiveType
PrimInt    (OpaqueMulti String
e) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
").Only()->AsInt()"
useAsUnboxed PrimitiveType
PrimFloat  (OpaqueMulti String
e) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
").Only()->AsFloat()"
useAsUnboxed PrimitiveType
PrimBool   (WrappedSingle String
e) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")->AsBool()"
useAsUnboxed PrimitiveType
PrimString (WrappedSingle String
e) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")->AsString()"
useAsUnboxed PrimitiveType
PrimChar   (WrappedSingle String
e) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")->AsChar()"
useAsUnboxed PrimitiveType
PrimInt    (WrappedSingle String
e) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")->AsInt()"
useAsUnboxed PrimitiveType
PrimFloat  (WrappedSingle String
e) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")->AsFloat()"
useAsUnboxed PrimitiveType
PrimBool   (UnwrappedSingle String
e) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")->AsBool()"
useAsUnboxed PrimitiveType
PrimString (UnwrappedSingle String
e) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")->AsString()"
useAsUnboxed PrimitiveType
PrimChar   (UnwrappedSingle String
e) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")->AsChar()"
useAsUnboxed PrimitiveType
PrimInt    (UnwrappedSingle String
e) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")->AsInt()"
useAsUnboxed PrimitiveType
PrimFloat  (UnwrappedSingle String
e) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")->AsFloat()"
useAsUnboxed PrimitiveType
_ (BoxedPrimitive PrimitiveType
_ String
e)   = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
useAsUnboxed PrimitiveType
_ (UnboxedPrimitive PrimitiveType
_ String
e) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
useAsUnboxed PrimitiveType
t (LazySingle ExprValue
e) = PrimitiveType -> ExprValue -> String
useAsUnboxed PrimitiveType
t (ExprValue -> String) -> ExprValue -> String
forall a b. (a -> b) -> a -> b
$ ExprValue -> ExprValue
getFromLazy ExprValue
e

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

valueAsUnwrapped :: ExprValue -> ExprValue
valueAsUnwrapped :: ExprValue -> ExprValue
valueAsUnwrapped (OpaqueMulti String
e)                 = String -> ExprValue
UnwrappedSingle (String -> ExprValue) -> String -> ExprValue
forall a b. (a -> b) -> a -> b
$ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
").Only()"
valueAsUnwrapped (WrappedSingle String
e)               = String -> ExprValue
UnwrappedSingle String
e
valueAsUnwrapped (UnboxedPrimitive PrimitiveType
PrimBool String
e)   = String -> ExprValue
UnwrappedSingle (String -> ExprValue) -> String -> ExprValue
forall a b. (a -> b) -> a -> b
$ String
"Box_Bool(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
valueAsUnwrapped (UnboxedPrimitive PrimitiveType
PrimString String
e) = String -> ExprValue
UnwrappedSingle (String -> ExprValue) -> String -> ExprValue
forall a b. (a -> b) -> a -> b
$ String
"Box_String(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
valueAsUnwrapped (UnboxedPrimitive PrimitiveType
PrimChar String
e)   = String -> ExprValue
UnwrappedSingle (String -> ExprValue) -> String -> ExprValue
forall a b. (a -> b) -> a -> b
$ String
"Box_Char(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
valueAsUnwrapped (UnboxedPrimitive PrimitiveType
PrimInt String
e)    = String -> ExprValue
UnwrappedSingle (String -> ExprValue) -> String -> ExprValue
forall a b. (a -> b) -> a -> b
$ String
"Box_Int(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
valueAsUnwrapped (UnboxedPrimitive PrimitiveType
PrimFloat String
e)  = String -> ExprValue
UnwrappedSingle (String -> ExprValue) -> String -> ExprValue
forall a b. (a -> b) -> a -> b
$ String
"Box_Float(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
valueAsUnwrapped (LazySingle ExprValue
e)                  = ExprValue -> ExprValue
valueAsUnwrapped (ExprValue -> ExprValue) -> ExprValue -> ExprValue
forall a b. (a -> b) -> a -> b
$ ExprValue -> ExprValue
getFromLazy ExprValue
e
valueAsUnwrapped ExprValue
v                               = ExprValue
v

variableStoredType :: ValueType -> String
variableStoredType :: ValueType -> String
variableStoredType ValueType
t
  | ValueType
t ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
== ValueType
boolRequiredValue   = String
"bool"
  | ValueType
t ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
== ValueType
intRequiredValue    = String
"PrimInt"
  | ValueType
t ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
== ValueType
floatRequiredValue  = String
"PrimFloat"
  | ValueType
t ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
== ValueType
charRequiredValue   = String
"PrimChar"
  | ValueType -> Bool
isWeakValue ValueType
t            = String
"W<TypeValue>"
  | Bool
otherwise                = String
"S<TypeValue>"

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

variableProxyType :: ValueType -> String
variableProxyType :: ValueType -> String
variableProxyType ValueType
t
  | ValueType
t ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
== ValueType
boolRequiredValue   = String
"bool"
  | ValueType
t ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
== ValueType
intRequiredValue    = String
"PrimInt"
  | ValueType
t ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
== ValueType
floatRequiredValue  = String
"PrimFloat"
  | ValueType
t ValueType -> ValueType -> Bool
forall a. Eq a => a -> a -> Bool
== ValueType
charRequiredValue   = String
"PrimChar"
  | ValueType -> Bool
isWeakValue ValueType
t            = String
"W<TypeValue>&"
  | Bool
otherwise                = String
"S<TypeValue>&"

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

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

functionLabelType :: ScopedFunction c -> String
functionLabelType :: ScopedFunction c -> String
functionLabelType = SymbolScope -> String
getType (SymbolScope -> String)
-> (ScopedFunction c -> SymbolScope) -> ScopedFunction c -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScopedFunction c -> SymbolScope
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
_             = String
forall a. HasCallStack => a
undefined

newFunctionLabel :: Int -> ScopedFunction c -> String
newFunctionLabel :: Int -> ScopedFunction c -> String
newFunctionLabel Int
i ScopedFunction c
f = String
"(*new " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (SymbolScope -> String
getType (SymbolScope -> String) -> SymbolScope -> String
forall a b. (a -> b) -> a -> b
$ ScopedFunction c -> SymbolScope
forall c. ScopedFunction c -> SymbolScope
sfScope ScopedFunction c
f) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"{ " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
args String -> String -> String
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  = Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ [ValueParam c] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ValueParam c] -> Int) -> [ValueParam c] -> Int
forall a b. (a -> b) -> a -> b
$ Positional (ValueParam c) -> [ValueParam c]
forall a. Positional a -> [a]
pValues (Positional (ValueParam c) -> [ValueParam c])
-> Positional (ValueParam c) -> [ValueParam c]
forall a b. (a -> b) -> a -> b
$ ScopedFunction c -> Positional (ValueParam c)
forall c. ScopedFunction c -> Positional (ValueParam c)
sfParams ScopedFunction c
f
  argCount :: String
argCount    = Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ [PassedValue c] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([PassedValue c] -> Int) -> [PassedValue c] -> Int
forall a b. (a -> b) -> a -> b
$ Positional (PassedValue c) -> [PassedValue c]
forall a. Positional a -> [a]
pValues (Positional (PassedValue c) -> [PassedValue c])
-> Positional (PassedValue c) -> [PassedValue c]
forall a b. (a -> b) -> a -> b
$ ScopedFunction c -> Positional (PassedValue c)
forall c. ScopedFunction c -> Positional (PassedValue c)
sfArgs ScopedFunction c
f
  returnCount :: String
returnCount = Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ [PassedValue c] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([PassedValue c] -> Int) -> [PassedValue c] -> Int
forall a b. (a -> b) -> a -> b
$ Positional (PassedValue c) -> [PassedValue c]
forall a. Positional a -> [a]
pValues (Positional (PassedValue c) -> [PassedValue c])
-> Positional (PassedValue c) -> [PassedValue c]
forall a b. (a -> b) -> a -> b
$ ScopedFunction c -> Positional (PassedValue c)
forall c. ScopedFunction c -> Positional (PassedValue c)
sfReturns ScopedFunction c
f
  category :: String
category    = String -> String
forall a. Show a => a -> String
show (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ CategoryName -> String
forall a. Show a => a -> String
show (CategoryName -> String) -> CategoryName -> String
forall a b. (a -> b) -> a -> b
$ ScopedFunction c -> CategoryName
forall c. ScopedFunction c -> CategoryName
sfType ScopedFunction c
f
  function :: String
function    = String -> String
forall a. Show a => a -> String
show (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ FunctionName -> String
forall a. Show a => a -> String
show (FunctionName -> String) -> FunctionName -> String
forall a b. (a -> b) -> a -> b
$ ScopedFunction c -> FunctionName
forall c. ScopedFunction c -> FunctionName
sfName ScopedFunction c
f
  collection :: String
collection  = CategoryName -> String
collectionName (CategoryName -> String) -> CategoryName -> String
forall a b. (a -> b) -> a -> b
$ ScopedFunction c -> CategoryName
forall c. ScopedFunction c -> CategoryName
sfType ScopedFunction c
f
  functionNum :: String
functionNum = Int -> String
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
_             = String
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<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
typeBase String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">"

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

escapeChar :: Char -> String
escapeChar :: Char -> String
escapeChar Char
c
  | Char
c Char -> Set Char -> Bool
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) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
16
    c2 :: Int
c2 = (Char -> Int
ord Char
c) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
16
    asHex :: Int -> Char
asHex Int
n
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10    = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Char -> Int
ord Char
'0')
      | Bool
otherwise = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Char -> Int
ord Char
'A') Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10

escapeChars :: String -> String
escapeChars :: String -> String
escapeChars String
cs
  | String -> Bool
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 Char -> Set Char -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Char
unescapedChars = Bool -> String -> String -> String
escapeAll Bool
False (String
ss String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c]) String
cs2
      | Bool
otherwise = String -> String
maybeQuote String
ss String -> String -> String
forall a. [a] -> [a] -> [a]
++ Bool -> String -> String -> String
escapeAll Bool
True String
"" (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
cs2)
    escapeAll Bool
True String
ss (Char
c:String
cs2)
      | Char
c Char -> Set Char -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Char
unescapedChars = String -> String
maybeQuote String
ss String -> String -> String
forall a. [a] -> [a] -> [a]
++ Bool -> String -> String -> String
escapeAll Bool
False String
"" (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
cs2)
      | Bool
otherwise = Bool -> String -> String -> String
escapeAll Bool
True (String
ss String -> String -> String
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
      | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ss = String
""
      | Bool
otherwise = String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ss String -> String -> String
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 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
testsOnlyMacro,
    String
"#error Category " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CategoryName -> String
forall a. Show a => a -> String
show CategoryName
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" can only be used by $TestsOnly$ categories",
    String
"#endif  // " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
testsOnlyMacro
  ]

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

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