uhc-light 1.1.8.6 → 1.1.8.7
raw patch · 377 files changed
+12097/−10247 lines, 377 filesdep ~uhc-lightdep ~uhc-utilbinary-added
Dependency ranges changed: uhc-light, uhc-util
Files
- 103/lib/ag/CoreRun/AbsSyn.ag +24/−23
- 103/lib/pkg/array-1.0.0.0/103/cr/plain/Data/Array.crr binary
- 103/lib/pkg/array-1.0.0.0/103/cr/plain/Data/Array.hi binary
- 103/lib/pkg/array-1.0.0.0/103/cr/plain/installed-pkg-config +1/−1
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Applicative.crr binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Applicative.hi binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Arrow.crr binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Arrow.hi binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Category.crr binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Category.hi binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Fix.crr binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Fix.hi binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Instances.crr binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Instances.hi binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST.crr binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST.hi binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST/Lazy.crr binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST/Lazy.hi binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Bool.crr binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Bool.hi binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Complex.crr binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Complex.hi binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Dynamic.crr binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Dynamic.hi binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Eq.crr binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Eq.hi binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Foldable.crr binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Foldable.hi binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Function.crr binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Function.hi binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ix.crr binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ix.hi binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Monoid.crr binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Monoid.hi binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ord.crr binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ord.hi binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ratio.crr binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ratio.hi binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/String.crr binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/String.hi binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Traversable.crr binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Traversable.hi binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Numeric.crr binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Numeric.hi binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Prelude.crr binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Prelude.hi binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Console/GetOpt.crr binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Console/GetOpt.hi binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Exit.crr binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Exit.hi binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadP.crr binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadP.hi binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadPrec.crr binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadPrec.hi binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read.crr binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read.hi binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read/Lex.crr binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read/Lex.hi binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show.crr binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show.hi binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show/Functions.crr binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show/Functions.hi binary
- 103/lib/pkg/base-3.0.0.0/103/cr/plain/installed-pkg-config +1/−1
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Control/Monad.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Control/Monad.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Data/Bits.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Data/Bits.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Data/Char.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Data/Char.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Data/Either.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Data/Either.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Data/IORef.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Data/IORef.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Data/List.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Data/List.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Data/Maybe.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Data/Maybe.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Data/Typeable.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Data/Typeable.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Debug/Trace.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Debug/Trace.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Foreign/Ptr.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Foreign/Ptr.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Foreign/StablePtr.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Foreign/StablePtr.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/System/IO.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/System/IO.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/System/IO/Error.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/System/IO/Error.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/System/IO/Fix.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/System/IO/Fix.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/System/IO/Unsafe.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/System/IO/Unsafe.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Array.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Array.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Base.cr too large to diff
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Base.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Bits.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Bits.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Bounded.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Bounded.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/BoxArray.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/BoxArray.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Char.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Char.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Enum.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Enum.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Eq.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Eq.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Float.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Float.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/GC.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/GC.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Generics.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Generics.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Generics/Tuple.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Generics/Tuple.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Handle.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Handle.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/IO.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/IO.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/IOBase.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/IOBase.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Ix.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Ix.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/LazyST.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/LazyST.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/MVar.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/MVar.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/MutVar.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/MutVar.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/OldException.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/OldException.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Ord.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Ord.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Prims.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Prims.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Ptr.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Ptr.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Read.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Read.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Real.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Real.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Run.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Run.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/ST.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/ST.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/STRef.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/STRef.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Show.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Show.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/StablePtr.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/StablePtr.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/StackTrace.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/StackTrace.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Types.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Types.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Weak.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Weak.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/WeakPtr.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/WeakPtr.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Unsafe/Coerce.cr binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Unsafe/Coerce.hi binary
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/include/CTypes.h +0/−231
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/include/HsBase.h +0/−757
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/include/HsBaseConfig.h +0/−944
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/include/IntLikeInstance.h +0/−242
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/include/MachDeps.h +0/−125
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/include/TupleInstance.h +0/−147
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/include/Typeable.h +0/−149
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/include/dirUtils.h +0/−11
- 103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/installed-pkg-config +0/−2
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Control/Monad.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Control/Monad.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Control/Monad.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/Bits.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/Bits.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/Bits.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/Char.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/Char.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/Char.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/Either.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/Either.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/Either.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/IORef.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/IORef.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/IORef.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/List.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/List.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/List.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/Maybe.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/Maybe.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/Maybe.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/Typeable.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/Typeable.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/Typeable.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Debug/Trace.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Debug/Trace.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Debug/Trace.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Foreign/Ptr.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Foreign/Ptr.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Foreign/Ptr.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Foreign/StablePtr.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Foreign/StablePtr.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Foreign/StablePtr.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/System/IO.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/System/IO.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/System/IO.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/System/IO/Error.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/System/IO/Error.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/System/IO/Error.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/System/IO/Fix.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/System/IO/Fix.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/System/IO/Fix.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/System/IO/Unsafe.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/System/IO/Unsafe.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/System/IO/Unsafe.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Array.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Array.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Array.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Base.cr too large to diff
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Base.crr too large to diff
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Base.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Bits.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Bits.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Bits.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Bounded.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Bounded.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Bounded.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/BoxArray.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/BoxArray.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/BoxArray.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Char.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Char.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Char.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Enum.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Enum.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Enum.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Eq.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Eq.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Eq.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Float.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Float.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Float.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/GC.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/GC.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/GC.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Generics.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Generics.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Generics.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Generics/Tuple.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Generics/Tuple.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Generics/Tuple.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Handle.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Handle.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Handle.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/IO.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/IO.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/IO.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/IOBase.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/IOBase.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/IOBase.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Ix.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Ix.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Ix.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/LazyST.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/LazyST.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/LazyST.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/MVar.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/MVar.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/MVar.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/MutVar.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/MutVar.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/MutVar.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/OldException.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/OldException.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/OldException.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Ord.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Ord.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Ord.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Prims.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Prims.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Prims.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Ptr.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Ptr.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Ptr.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Read.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Read.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Read.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Real.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Real.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Real.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Run.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Run.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Run.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/ST.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/ST.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/ST.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/STRef.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/STRef.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/STRef.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Show.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Show.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Show.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/StablePtr.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/StablePtr.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/StablePtr.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/StackTrace.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/StackTrace.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/StackTrace.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Types.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Types.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Types.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Weak.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Weak.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Weak.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/WeakPtr.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/WeakPtr.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/WeakPtr.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Unsafe/Coerce.cr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Unsafe/Coerce.crr binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Unsafe/Coerce.hi binary
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/include/CTypes.h +231/−0
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/include/HsBase.h +757/−0
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/include/HsBaseConfig.h +944/−0
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/include/IntLikeInstance.h +242/−0
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/include/MachDeps.h +125/−0
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/include/TupleInstance.h +147/−0
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/include/Typeable.h +149/−0
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/include/dirUtils.h +11/−0
- 103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/installed-pkg-config +2/−0
- changelog.md +6/−1
- src-main/EHCRun.hs +2/−1
- src/UHC/Light/Compiler/Base/Target.hs +52/−30
- src/UHC/Light/Compiler/Config.hs +22/−4
- src/UHC/Light/Compiler/ConfigInstall.hs +1/−1
- src/UHC/Light/Compiler/ConfigInternalVersions.hs +21/−10
- src/UHC/Light/Compiler/Core/ToCoreRun.hs +5959/−5731
- src/UHC/Light/Compiler/Core/Trf.hs +1/−1
- src/UHC/Light/Compiler/CoreRun.hs +236/−19
- src/UHC/Light/Compiler/CoreRun/API.hs +7/−3
- src/UHC/Light/Compiler/CoreRun/API/Internal.hs +3/−2
- src/UHC/Light/Compiler/CoreRun/Check.hs +531/−0
- src/UHC/Light/Compiler/CoreRun/Parser.hs +16/−6
- src/UHC/Light/Compiler/CoreRun/Pretty.hs +231/−71
- src/UHC/Light/Compiler/CoreRun/Prim.hs +21/−8
- src/UHC/Light/Compiler/CoreRun/Run/Val.hs +1266/−1147
- src/UHC/Light/Compiler/CoreRun/Run/Val/Prim.hs +60/−45
- src/UHC/Light/Compiler/CoreRun/Run/Val/RunExplStk.hs +94/−32
- src/UHC/Light/Compiler/CoreRun/Run/Val/RunImplStk.hs +15/−14
- src/UHC/Light/Compiler/EHC/BuildFunction.hs +48/−0
- src/UHC/Light/Compiler/EHC/BuildFunction/Run.hs +25/−0
- src/UHC/Light/Compiler/EHC/Common.hs +35/−16
- src/UHC/Light/Compiler/EHC/CompilePhase/Cleanup.hs +7/−7
- src/UHC/Light/Compiler/EHC/CompilePhase/Common.hs +6/−6
- src/UHC/Light/Compiler/EHC/CompilePhase/CompileC.hs +12/−12
- src/UHC/Light/Compiler/EHC/CompilePhase/FlowBetweenPhase.hs +16/−22
- src/UHC/Light/Compiler/EHC/CompilePhase/Link.hs +2/−2
- src/UHC/Light/Compiler/EHC/CompilePhase/Module.hs +59/−36
- src/UHC/Light/Compiler/EHC/CompilePhase/Output.hs +63/−19
- src/UHC/Light/Compiler/EHC/CompilePhase/Parsers.hs +56/−37
- src/UHC/Light/Compiler/EHC/CompilePhase/Run.hs +26/−4
- src/UHC/Light/Compiler/EHC/CompilePhase/Semantics.hs +66/−15
- src/UHC/Light/Compiler/EHC/CompilePhase/TopLevelPhases.hs +222/−121
- src/UHC/Light/Compiler/EHC/CompilePhase/Transformations.hs +2/−2
- src/UHC/Light/Compiler/EHC/CompilePhase/Translations.hs +7/−7
- src/UHC/Light/Compiler/EHC/CompileRun.hs +78/−49
- src/UHC/Light/Compiler/EHC/CompileUnit.hs +73/−30
- src/UHC/Light/Compiler/EHC/InitialSetup.hs +11/−4
- src/UHC/Light/Compiler/EHC/Main.hs +20/−10
- src/UHC/Light/Compiler/EHC/Main/Utils.hs +2/−1
- src/UHC/Light/Compiler/HI.hs +19/−21
- src/UHC/Light/Compiler/Opts.hs +54/−57
- src/UHC/Light/Compiler/Opts/Base.hs +1/−1
- src/UHC/Light/Compiler/Scanner/Common.hs +2/−2
- src/UHC/Light/Compiler/SourceCodeSig.hs +2/−2
- uhc-light.cabal +5/−5
@@ -1,12 +1,23 @@+DATA AGItf+ | AGItf module : Mod+ DATA Mod | Mod ref2nm : {Ref2Nm} -- inverse lookup of locally introduced binding RRef's moduleNm : {HsName} moduleNr : {Int} -- sequence nr, index later into global table of modules stkDepth : {Int} -- max depth of stack for setting up globals+ imports : ImportL metas : MetaL binds : {CRArray Bind}- body : Exp+ mbbody : MbExp +DATA Import+ | Import nm : {HsName}++TYPE ImportL = [Import]++SET AllImport = Import ImportL+ DATA Meta | Data tyNm : {HsName} dataCons : DataConL@@ -46,35 +57,23 @@ args : {CRArray SExp} -- let bindings, recursiveness allowed, yes/no eval made explicit in rhs of binding- | Let -- lev : {Int}- firstOff : {Int} -- offset of first binding+ | Let firstOff : {Int} -- offset of first binding ref2nm : {Ref2Nm} -- inverse lookup of locally introduced binding RRef's binds : {CRArray Bind} body : Exp -- application, abstraction- | App -- isTailRec : {Bool}- func : Exp+ | App func : Exp args : {CRArray SExp} | Lam mbNm : {Maybe HsName} -- possibly bound to name- -- lev : {Int} -- lexical level nrArgs : {Int} -- nr of arguments, 0 means it is a thunk- -- nrBinds : {Int} -- nr stack frame locations to be allocated (excluding arguments) for locals stkDepth : {Int} -- max depth of stack ref2nm : {Ref2Nm} -- inverse lookup of locally introduced binding RRef's body : Exp -- thunking, forcing, partial applications | Force expr : Exp- -- | Thunk expr : Exp -- expressed as parameterless Lam - -- expr in a context to which must be returned (i.e. no tail rec)- -- | Ret expr : Exp-- -- expr in a case alternative result context (with local bindings to be removed)- -- | RetCase nrBinds : {Int}- -- expr : Exp- -- Tail context | Tail expr : Exp @@ -85,14 +84,13 @@ -- FFI call | FFI prim : {RunPrim} args : {CRArray SExp}-{-- | FFI callconv : {FFIWay}- impEnt : {ForeignEnt}- ty : {Ty}- args : {CRArray Exp}--} +TYPE MbExp = MAYBE Exp +SET AllExp = Exp MbExp+++ DATA Alt | Alt ref2nm : {Ref2Nm} -- inverse lookup of locally introduced binding RRef's -- pat : Pat@@ -100,7 +98,10 @@ DATA Pat | Con tag : {Int}- | BoolExpr expr : Exp+ -- | BoolExpr expr : Exp +SET AllCodeNT+ = Mod SExp AllExp Alt Pat+ SET AllNT- = Mod SExp Exp Alt Pat+ = AllCodeNT AllImport AllMetaNT
binary file changed (absent → 293 bytes)
binary file changed (6272 → 6274 bytes)
@@ -1,2 +1,2 @@ exposed-modules: Data.Array-build-depends: uhcbase-1.1.8.6 base-3.0.0.0+build-depends: uhcbase-1.1.8.7 base-3.0.0.0
binary file changed (absent → 214409 bytes)
binary file changed (116222 → 84386 bytes)
binary file changed (absent → 212336 bytes)
binary file changed (140282 → 116505 bytes)
binary file changed (absent → 6839 bytes)
binary file changed (10045 → 9358 bytes)
binary file changed (absent → 22386 bytes)
binary file changed (18302 → 15165 bytes)
binary file changed (absent → 18112 bytes)
binary file changed (13430 → 10427 bytes)
binary file changed (absent → 3621 bytes)
binary file changed (7497 → 6903 bytes)
binary file changed (absent → 4765 bytes)
binary file changed (8545 → 7877 bytes)
binary file changed (absent → 140 bytes)
binary file changed (4493 → 4495 bytes)
binary file changed (absent → 303111 bytes)
binary file changed (49047 → 29049 bytes)
binary file changed (absent → 56237 bytes)
binary file changed (28461 → 21943 bytes)
binary file changed (absent → 138 bytes)
binary file changed (3879 → 3881 bytes)
binary file changed (absent → 81169 bytes)
binary file changed (32505 → 27748 bytes)
binary file changed (absent → 1905 bytes)
binary file changed (4931 → 4895 bytes)
binary file changed (absent → 185 bytes)
binary file changed (4378 → 4380 bytes)
binary file changed (absent → 522719 bytes)
binary file changed (182318 → 118240 bytes)
binary file changed (absent → 1454 bytes)
binary file changed (5745 → 5728 bytes)
binary file changed (absent → 38582 bytes)
binary file changed (6454 → 4886 bytes)
binary file changed (absent → 4814 bytes)
binary file changed (7763 → 7148 bytes)
binary file changed (absent → 158754 bytes)
binary file changed (79702 → 56289 bytes)
binary file changed (absent → 3281 bytes)
binary file changed (6620 → 6565 bytes)
binary file changed (absent → 635 bytes)
binary file changed (63707 → 63709 bytes)
binary file changed (absent → 326194 bytes)
binary file changed (77868 → 52652 bytes)
binary file changed (absent → 1783 bytes)
binary file changed (5235 → 5077 bytes)
binary file changed (absent → 269721 bytes)
binary file changed (69319 → 45795 bytes)
binary file changed (absent → 46701 bytes)
binary file changed (27804 → 21088 bytes)
binary file changed (absent → 140 bytes)
binary file changed (4498 → 4500 bytes)
binary file changed (absent → 385931 bytes)
binary file changed (49978 → 28513 bytes)
binary file changed (absent → 4981 bytes)
binary file changed (5464 → 5328 bytes)
binary file changed (absent → 4619 bytes)
binary file changed (6144 → 5369 bytes)
@@ -1,2 +1,2 @@ exposed-modules: Control.Applicative Control.Arrow Control.Category Control.Monad.Fix Control.Monad.Instances Control.Monad.ST.Lazy Control.Monad.ST Data.Bool Data.Complex Data.Dynamic Data.Eq Data.Foldable Data.Function Data.Ix Data.Monoid Data.Ord Data.Ratio Data.String Data.Traversable Numeric Prelude System.Console.GetOpt System.Environment System.Exit Text.ParserCombinators.ReadP Text.ParserCombinators.ReadPrec Text.Read.Lex Text.Read Text.Show.Functions Text.Show-build-depends: uhcbase-1.1.8.6+build-depends: uhcbase-1.1.8.7
binary file changed (61204 → absent bytes)
binary file changed (27704 → absent bytes)
binary file changed (82640 → absent bytes)
binary file changed (24833 → absent bytes)
binary file changed (11493 → absent bytes)
binary file changed (5668 → absent bytes)
binary file changed (6580 → absent bytes)
binary file changed (3864 → absent bytes)
binary file changed (3460 → absent bytes)
binary file changed (3315 → absent bytes)
binary file changed (204309 → absent bytes)
binary file changed (46537 → absent bytes)
binary file changed (8206 → absent bytes)
binary file changed (4487 → absent bytes)
binary file changed (175368 → absent bytes)
binary file changed (112836 → absent bytes)
binary file changed (3180 → absent bytes)
binary file changed (4479 → absent bytes)
binary file changed (405 → absent bytes)
binary file changed (3275 → absent bytes)
binary file changed (149 → absent bytes)
binary file changed (2259 → absent bytes)
binary file changed (22836 → absent bytes)
binary file changed (17797 → absent bytes)
binary file changed (30548 → absent bytes)
binary file changed (16760 → absent bytes)
binary file changed (4750 → absent bytes)
binary file changed (2294 → absent bytes)
binary file changed (1004 → absent bytes)
binary file changed (1984 → absent bytes)
binary file changed (216779 → absent bytes)
binary file changed (64601 → absent bytes)
file too large to diff
binary file changed (950230 → absent bytes)
binary file changed (13522 → absent bytes)
binary file changed (5335 → absent bytes)
binary file changed (122012 → absent bytes)
binary file changed (60961 → absent bytes)
binary file changed (29641 → absent bytes)
binary file changed (21229 → absent bytes)
binary file changed (5241 → absent bytes)
binary file changed (1288 → absent bytes)
binary file changed (8372 → absent bytes)
binary file changed (4111 → absent bytes)
binary file changed (107242 → absent bytes)
binary file changed (66526 → absent bytes)
binary file changed (58825 → absent bytes)
binary file changed (4807 → absent bytes)
binary file changed (688 → absent bytes)
binary file changed (1259 → absent bytes)
binary file changed (207 → absent bytes)
binary file changed (16434 → absent bytes)
binary file changed (670235 → absent bytes)
binary file changed (421058 → absent bytes)
binary file changed (132474 → absent bytes)
binary file changed (46634 → absent bytes)
binary file changed (15533 → absent bytes)
binary file changed (5975 → absent bytes)
binary file changed (340989 → absent bytes)
binary file changed (154381 → absent bytes)
binary file changed (76885 → absent bytes)
binary file changed (30408 → absent bytes)
binary file changed (37718 → absent bytes)
binary file changed (23326 → absent bytes)
binary file changed (29152 → absent bytes)
binary file changed (10285 → absent bytes)
binary file changed (18353 → absent bytes)
binary file changed (10662 → absent bytes)
binary file changed (12357 → absent bytes)
binary file changed (5421 → absent bytes)
binary file changed (68995 → absent bytes)
binary file changed (21750 → absent bytes)
binary file changed (206208 → absent bytes)
binary file changed (73547 → absent bytes)
binary file changed (25281 → absent bytes)
binary file changed (21209 → absent bytes)
binary file changed (87664 → absent bytes)
binary file changed (17136 → absent bytes)
binary file changed (7211 → absent bytes)
binary file changed (1916 → absent bytes)
binary file changed (11814 → absent bytes)
binary file changed (5056 → absent bytes)
binary file changed (47946 → absent bytes)
binary file changed (31521 → absent bytes)
binary file changed (22999 → absent bytes)
binary file changed (15434 → absent bytes)
binary file changed (152800 → absent bytes)
binary file changed (36709 → absent bytes)
binary file changed (21991 → absent bytes)
binary file changed (16107 → absent bytes)
binary file changed (141 → absent bytes)
binary file changed (1380 → absent bytes)
binary file changed (69186 → absent bytes)
binary file changed (51972 → absent bytes)
binary file changed (27276 → absent bytes)
binary file changed (18131 → absent bytes)
binary file changed (13934 → absent bytes)
binary file changed (9775 → absent bytes)
binary file changed (140 → absent bytes)
binary file changed (853 → absent bytes)
@@ -1,231 +0,0 @@-{- ---------------------------------------------------------------------------// Dirty CPP hackery for CTypes/CTypesISO-//-// (c) The FFI task force, 2000-// ----------------------------------------------------------------------------}--#ifndef CTYPES__H-#define CTYPES__H--#include "Typeable.h"--{--// As long as there is no automatic derivation of classes for newtypes we resort-// to extremely dirty cpp-hackery. :-P Some care has to be taken when the-// macros below are modified, otherwise the layout rule will bite you.--}---- // A hacked version for GHC follows the Haskell 98 version...-#ifndef __GLASGOW_HASKELL__--#define NEWTYPE_TYPE_NODERIVING(T,B) \-newtype T = T B ; --#define NEWTYPE_TYPE(T,B) \-newtype T = T B deriving (Eq, Ord) ; --#define ARITHMETIC_TYPE_INSTANCES(T,C,S,B) \-INSTANCE_NUM(T) ; \-INSTANCE_REAL(T) ; \-INSTANCE_READ(T,B) ; \-INSTANCE_SHOW(T,B) ; \-INSTANCE_ENUM(T) ; \-INSTANCE_STORABLE(T) ; \-INSTANCE_TYPEABLE0(T,C,S) ;--#define INTEGRAL_TYPE_INSTANCES(T,C,S,B) \-INSTANCE_BOUNDED(T) ; \-INSTANCE_INTEGRAL(T) ; \-INSTANCE_BITS(T)--#define ARITHMETIC_TYPE(T,C,S,B) \-NEWTYPE_TYPE(T,B) ; \-ARITHMETIC_TYPE_INSTANCES(T,C,S,B) ;--#define INTEGRAL_TYPE(T,C,S,B) \-ARITHMETIC_TYPE(T,C,S,B) ; \-INTEGRAL_TYPE_INSTANCES(T,C,S,B)--#define FLOATING_TYPE(T,C,S,B) \-ARITHMETIC_TYPE(T,C,S,B) ; \-INSTANCE_FRACTIONAL(T) ; \-INSTANCE_FLOATING(T) ; \-INSTANCE_REALFRAC(T) ; \-INSTANCE_REALFLOAT(T)--#ifndef __GLASGOW_HASKELL__-#define fakeMap map-#endif--#define INSTANCE_READ(T,B) \-instance Read T where { \- readsPrec p s = fakeMap (\(x, t) -> (T x, t)) (readsPrec p s) }--#define INSTANCE_SHOW(T,B) \-instance Show T where { \- showsPrec p (T x) = showsPrec p x }--#define INSTANCE_NUM(T) \-instance Num T where { \- (T i) + (T j) = T (i + j) ; \- (T i) - (T j) = T (i - j) ; \- (T i) * (T j) = T (i * j) ; \- negate (T i) = T (negate i) ; \- abs (T i) = T (abs i) ; \- signum (T i) = T (signum i) ; \- fromInteger x = T (fromInteger x) }--#define INSTANCE_EQ(T) \-instance Eq T where { \- (T x1) == (T x2) = x1 == x2 }--#define INSTANCE_ORD(T) \-instance Ord T where { \- (T x1) `compare` (T x2) = x1 `compare` x2 }--#define INSTANCE_BOUNDED(T) \-instance Bounded T where { \- minBound = T minBound ; \- maxBound = T maxBound }--#define INSTANCE_ENUM(T) \-instance Enum T where { \- succ (T i) = T (succ i) ; \- pred (T i) = T (pred i) ; \- toEnum x = T (toEnum x) ; \- fromEnum (T i) = fromEnum i ; \- enumFrom (T i) = fakeMap T (enumFrom i) ; \- enumFromThen (T i) (T j) = fakeMap T (enumFromThen i j) ; \- enumFromTo (T i) (T j) = fakeMap T (enumFromTo i j) ; \- enumFromThenTo (T i) (T j) (T k) = fakeMap T (enumFromThenTo i j k) }--#define INSTANCE_REAL(T) \-instance Real T where { \- toRational (T i) = toRational i }--#define INSTANCE_INTEGRAL(T) \-instance Integral T where { \- (T i) `quot` (T j) = T (i `quot` j) ; \- (T i) `rem` (T j) = T (i `rem` j) ; \- (T i) `div` (T j) = T (i `div` j) ; \- (T i) `mod` (T j) = T (i `mod` j) ; \- (T i) `quotRem` (T j) = let (q,r) = i `quotRem` j in (T q, T r) ; \- (T i) `divMod` (T j) = let (d,m) = i `divMod` j in (T d, T m) ; \- toInteger (T i) = toInteger i }--#define INSTANCE_BITS(T) \-instance Bits T where { \- (T x) .&. (T y) = T (x .&. y) ; \- (T x) .|. (T y) = T (x .|. y) ; \- (T x) `xor` (T y) = T (x `xor` y) ; \- complement (T x) = T (complement x) ; \- shift (T x) n = T (shift x n) ; \- rotate (T x) n = T (rotate x n) ; \- bit n = T (bit n) ; \- setBit (T x) n = T (setBit x n) ; \- clearBit (T x) n = T (clearBit x n) ; \- complementBit (T x) n = T (complementBit x n) ; \- testBit (T x) n = testBit x n ; \- bitSize (T x) = bitSize x ; \- isSigned (T x) = isSigned x }--#define INSTANCE_FRACTIONAL(T) \-instance Fractional T where { \- (T x) / (T y) = T (x / y) ; \- recip (T x) = T (recip x) ; \- fromRational r = T (fromRational r) }--#define INSTANCE_FLOATING(T) \-instance Floating T where { \- pi = pi ; \- exp (T x) = T (exp x) ; \- log (T x) = T (log x) ; \- sqrt (T x) = T (sqrt x) ; \- (T x) ** (T y) = T (x ** y) ; \- (T x) `logBase` (T y) = T (x `logBase` y) ; \- sin (T x) = T (sin x) ; \- cos (T x) = T (cos x) ; \- tan (T x) = T (tan x) ; \- asin (T x) = T (asin x) ; \- acos (T x) = T (acos x) ; \- atan (T x) = T (atan x) ; \- sinh (T x) = T (sinh x) ; \- cosh (T x) = T (cosh x) ; \- tanh (T x) = T (tanh x) ; \- asinh (T x) = T (asinh x) ; \- acosh (T x) = T (acosh x) ; \- atanh (T x) = T (atanh x) }--#define INSTANCE_REALFRAC(T) \-instance RealFrac T where { \- properFraction (T x) = let (m,y) = properFraction x in (m, T y) ; \- truncate (T x) = truncate x ; \- round (T x) = round x ; \- ceiling (T x) = ceiling x ; \- floor (T x) = floor x }--#define INSTANCE_REALFLOAT(T) \-instance RealFloat T where { \- floatRadix (T x) = floatRadix x ; \- floatDigits (T x) = floatDigits x ; \- floatRange (T x) = floatRange x ; \- decodeFloat (T x) = decodeFloat x ; \- encodeFloat m n = T (encodeFloat m n) ; \- exponent (T x) = exponent x ; \- significand (T x) = T (significand x) ; \- scaleFloat n (T x) = T (scaleFloat n x) ; \- isNaN (T x) = isNaN x ; \- isInfinite (T x) = isInfinite x ; \- isDenormalized (T x) = isDenormalized x ; \- isNegativeZero (T x) = isNegativeZero x ; \- isIEEE (T x) = isIEEE x ; \- (T x) `atan2` (T y) = T (x `atan2` y) }--#define INSTANCE_STORABLE(T) \-instance Storable T where { \- sizeOf (T x) = sizeOf x ; \- alignment (T x) = alignment x ; \- peekElemOff a i = liftM T (peekElemOff (castPtr a) i) ; \- pokeElemOff a i (T x) = pokeElemOff (castPtr a) i x }--#else /* __GLASGOW_HASKELL__ */---- // GHC can derive any class for a newtype, so we make use of that here...--#define ARITHMETIC_CLASSES Eq,Ord,Num,Enum,Storable,Real-#define INTEGRAL_CLASSES Bounded,Integral,Bits-#define FLOATING_CLASSES Fractional,Floating,RealFrac,RealFloat--#define ARITHMETIC_TYPE(T,C,S,B) \-newtype T = T B deriving (ARITHMETIC_CLASSES); \-INSTANCE_READ(T,B); \-INSTANCE_SHOW(T,B); \-INSTANCE_TYPEABLE0(T,C,S) ;--#define INTEGRAL_TYPE(T,C,S,B) \-newtype T = T B deriving (ARITHMETIC_CLASSES, INTEGRAL_CLASSES); \-INSTANCE_READ(T,B); \-INSTANCE_SHOW(T,B); \-INSTANCE_TYPEABLE0(T,C,S) ;--#define FLOATING_TYPE(T,C,S,B) \-newtype T = T B deriving (ARITHMETIC_CLASSES, FLOATING_CLASSES); \-INSTANCE_READ(T,B); \-INSTANCE_SHOW(T,B); \-INSTANCE_TYPEABLE0(T,C,S) ;--#define INSTANCE_READ(T,B) \-instance Read T where { \- readsPrec = unsafeCoerce# (readsPrec :: Int -> ReadS B); \- readList = unsafeCoerce# (readList :: ReadS [B]); }--#define INSTANCE_SHOW(T,B) \-instance Show T where { \- showsPrec = unsafeCoerce# (showsPrec :: Int -> B -> ShowS); \- show = unsafeCoerce# (show :: B -> String); \- showList = unsafeCoerce# (showList :: [B] -> ShowS); }--#endif /* __GLASGOW_HASKELL__ */--#endif
@@ -1,757 +0,0 @@-/* ------------------------------------------------------------------------------ *- * (c) The University of Glasgow 2001-2004- *- * Definitions for package `base' which are visible in Haskell land.- *- * Adapted for use in EHC- *- * ---------------------------------------------------------------------------*/--#ifndef __HSBASE_H__-#define __HSBASE_H__--#include "HsBaseConfig.h"-#ifdef __UHC_BUILDS_O__-#include "rts.h"-#endif--/* ultra-evil... */-#undef PACKAGE_BUGREPORT-#undef PACKAGE_NAME-#undef PACKAGE_STRING-#undef PACKAGE_TARNAME-#undef PACKAGE_VERSION--/* Needed to get the macro version of errno on some OSs (eg. Solaris).- We must do this, because these libs are only compiled once, but- must work in both single-threaded and multi-threaded programs. */-#define _REENTRANT 1--#ifndef __UHC__-#include "HsFFI.h"-#endif /* !__UHC__ */--#include <stdio.h>-#include <stdlib.h>-#include <math.h>--#if HAVE_SYS_TYPES_H-#include <sys/types.h>-#endif-#if HAVE_UNISTD_H-#include <unistd.h>-#endif-#if HAVE_SYS_STAT_H-#include <sys/stat.h>-#endif-#if HAVE_FCNTL_H-# include <fcntl.h>-#endif-#if HAVE_TERMIOS_H-#include <termios.h>-#endif-#if HAVE_SIGNAL_H-#include <signal.h>-/* Ultra-ugly: OpenBSD uses broken macros for sigemptyset and sigfillset (missing casts) */-#if __OpenBSD__-#undef sigemptyset-#undef sigfillset-#endif-#endif-#if HAVE_ERRNO_H-#include <errno.h>-#endif-#if HAVE_STRING_H-#include <string.h>-#endif-#if HAVE_DIRENT_H-#include <dirent.h>-#endif-#if HAVE_UTIME_H-#include <utime.h>-#endif-#if HAVE_SYS_UTSNAME_H-#include <sys/utsname.h>-#endif-#if HAVE_GETTIMEOFDAY-# if HAVE_SYS_TIME_H-# include <sys/time.h>-# endif-#elif HAVE_GETCLOCK-# if HAVE_SYS_TIMERS_H-# define POSIX_4D9 1-# include <sys/timers.h>-# endif-#endif-#if HAVE_TIME_H-#include <time.h>-#endif-#if HAVE_SYS_TIMEB_H-#include <sys/timeb.h>-#endif-#if HAVE_WINDOWS_H-#include <windows.h>-#endif-#if HAVE_SYS_TIMES_H-#include <sys/times.h>-#endif-#if HAVE_WINSOCK_H && defined(__MINGW32__)-#include <winsock.h>-#endif-#if HAVE_LIMITS_H-#include <limits.h>-#endif-#if HAVE_WCTYPE_H-#include <wctype.h>-#endif-#if HAVE_INTTYPES_H-# include <inttypes.h>-#elif HAVE_STDINT_H-# include <stdint.h>-#endif--#if !defined(__MINGW32__) && !defined(irix_HOST_OS)-# if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-# endif-#endif--#if !HAVE_GETRUSAGE && HAVE_SYS_SYSCALL_H-# include <sys/syscall.h>-# if defined(SYS_GETRUSAGE) /* hpux_HOST_OS */-# define getrusage(a, b) syscall(SYS_GETRUSAGE, a, b)-# define HAVE_GETRUSAGE 1-# endif-#endif--/* For System */-#if HAVE_SYS_WAIT_H-#include <sys/wait.h>-#endif-#if HAVE_VFORK_H-#include <vfork.h>-#endif--#ifndef __UHC__-#include "dirUtils.h"-#endif-#ifndef __UHC__-#include "WCsubst.h"-#endif /* !__UHC__ */--#if defined(__MINGW32__)-/* in Win32Utils.c */-extern void maperrno (void);-extern HsWord64 getUSecOfDay(void);-#endif--#if defined(__MINGW32__)-#include <io.h>-#include <fcntl.h>-#include <shlobj.h>-#include <share.h>-#endif--#if HAVE_SYS_SELECT_H-#include <sys/select.h>-#endif--/* in inputReady.c */-extern int fdReady(int fd, int write, int msecs, int isSock);--#ifndef __UHC__-/* in Signals.c */-extern HsInt nocldstop;-#endif /* !__UHC__ */--#ifndef __UHC__-/* ------------------------------------------------------------------------------ 64-bit operations, defined in longlong.c- -------------------------------------------------------------------------- */--#ifdef SUPPORT_LONG_LONGS--HsBool hs_gtWord64 (HsWord64, HsWord64);-HsBool hs_geWord64 (HsWord64, HsWord64);-HsBool hs_eqWord64 (HsWord64, HsWord64);-HsBool hs_neWord64 (HsWord64, HsWord64);-HsBool hs_ltWord64 (HsWord64, HsWord64);-HsBool hs_leWord64 (HsWord64, HsWord64);--HsBool hs_gtInt64 (HsInt64, HsInt64);-HsBool hs_geInt64 (HsInt64, HsInt64);-HsBool hs_eqInt64 (HsInt64, HsInt64);-HsBool hs_neInt64 (HsInt64, HsInt64);-HsBool hs_ltInt64 (HsInt64, HsInt64);-HsBool hs_leInt64 (HsInt64, HsInt64);--HsWord64 hs_remWord64 (HsWord64, HsWord64);-HsWord64 hs_quotWord64 (HsWord64, HsWord64);--HsInt64 hs_remInt64 (HsInt64, HsInt64);-HsInt64 hs_quotInt64 (HsInt64, HsInt64);-HsInt64 hs_negateInt64 (HsInt64);-HsInt64 hs_plusInt64 (HsInt64, HsInt64);-HsInt64 hs_minusInt64 (HsInt64, HsInt64);-HsInt64 hs_timesInt64 (HsInt64, HsInt64);--HsWord64 hs_and64 (HsWord64, HsWord64);-HsWord64 hs_or64 (HsWord64, HsWord64);-HsWord64 hs_xor64 (HsWord64, HsWord64);-HsWord64 hs_not64 (HsWord64);--HsWord64 hs_uncheckedShiftL64 (HsWord64, HsInt);-HsWord64 hs_uncheckedShiftRL64 (HsWord64, HsInt);-HsInt64 hs_uncheckedIShiftL64 (HsInt64, HsInt);-HsInt64 hs_uncheckedIShiftRA64 (HsInt64, HsInt);-HsInt64 hs_uncheckedIShiftRL64 (HsInt64, HsInt);--HsInt64 hs_intToInt64 (HsInt);-HsInt hs_int64ToInt (HsInt64);-HsWord64 hs_int64ToWord64 (HsInt64);-HsWord64 hs_wordToWord64 (HsWord);-HsWord hs_word64ToWord (HsWord64);-HsInt64 hs_word64ToInt64 (HsWord64);--HsWord64 hs_integerToWord64 (HsInt sa, StgByteArray /* Really: mp_limb_t* */ da);-HsInt64 hs_integerToInt64 (HsInt sa, StgByteArray /* Really: mp_limb_t* */ da);--#endif /* SUPPORT_LONG_LONGS */-#endif /* !__UHC__ */--/* ------------------------------------------------------------------------------ INLINE functions.-- These functions are given as inlines here for when compiling via C,- but we also generate static versions into the cbits library for- when compiling to native code.- -------------------------------------------------------------------------- */--#ifndef INLINE-# if defined(_MSC_VER)-# define INLINE extern __inline-# else-# define INLINE static inline-# endif-#endif--INLINE int __hscore_get_errno(void) { return errno; }-INLINE void __hscore_set_errno(int e) { errno = e; }--#if !defined(_MSC_VER)-INLINE int __hscore_s_isreg(mode_t m) { return S_ISREG(m); }-INLINE int __hscore_s_isdir(mode_t m) { return S_ISDIR(m); }-INLINE int __hscore_s_isfifo(mode_t m) { return S_ISFIFO(m); }-INLINE int __hscore_s_isblk(mode_t m) { return S_ISBLK(m); }-INLINE int __hscore_s_ischr(mode_t m) { return S_ISCHR(m); }-#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)-INLINE int __hscore_s_issock(mode_t m) { return S_ISSOCK(m); }-#endif-#endif--#if ( !defined(_MSC_VER) && !defined(__MINGW32__) && !defined(_WIN32) ) || defined(__CYGWIN__)-INLINE int-__hscore_sigemptyset( sigset_t *set )-{ return sigemptyset(set); }--INLINE int-__hscore_sigfillset( sigset_t *set )-{ return sigfillset(set); }--INLINE int-__hscore_sigaddset( sigset_t * set, int s )-{ return sigaddset(set,s); }--INLINE int-__hscore_sigdelset( sigset_t * set, int s )-{ return sigdelset(set,s); }--INLINE int-__hscore_sigismember( sigset_t * set, int s )-{ return sigismember(set,s); }-#endif--INLINE void *-__hscore_memcpy_dst_off( char *dst, int dst_off, char *src, size_t sz )-{ return memcpy(dst+dst_off, src, sz); }--INLINE void *-__hscore_memcpy_src_off( char *dst, char *src, int src_off, size_t sz )-{ return memcpy(dst, src+src_off, sz); }--INLINE HsBool-__hscore_supportsTextMode()-{-#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)- return HS_BOOL_FALSE;-#else- return HS_BOOL_TRUE;-#endif-}--INLINE HsInt-__hscore_bufsiz()-{- return BUFSIZ;-}--INLINE int-__hscore_seek_cur()-{- return SEEK_CUR;-}--INLINE int-__hscore_o_binary()-{-#if defined(_MSC_VER)- return O_BINARY;-#else- return CONST_O_BINARY;-#endif-}--INLINE int-__hscore_o_rdonly()-{-#ifdef O_RDONLY- return O_RDONLY;-#else- return 0;-#endif-}--INLINE int-__hscore_o_wronly( void )-{-#ifdef O_WRONLY- return O_WRONLY;-#else- return 0;-#endif-}--INLINE int-__hscore_o_rdwr( void )-{-#ifdef O_RDWR- return O_RDWR;-#else- return 0;-#endif-}--INLINE int-__hscore_o_append( void )-{-#ifdef O_APPEND- return O_APPEND;-#else- return 0;-#endif-}--INLINE int-__hscore_o_creat( void )-{-#ifdef O_CREAT- return O_CREAT;-#else- return 0;-#endif-}--INLINE int-__hscore_o_excl( void )-{-#ifdef O_EXCL- return O_EXCL;-#else- return 0;-#endif-}--INLINE int-__hscore_o_trunc( void )-{-#ifdef O_TRUNC- return O_TRUNC;-#else- return 0;-#endif-}--INLINE int-__hscore_o_noctty( void )-{-#ifdef O_NOCTTY- return O_NOCTTY;-#else- return 0;-#endif-}--INLINE int-__hscore_o_nonblock( void )-{-#ifdef O_NONBLOCK- return O_NONBLOCK;-#else- return 0;-#endif-}--INLINE int-__hscore_seek_set( void )-{- return SEEK_SET;-}--INLINE int-__hscore_seek_end( void )-{- return SEEK_END;-}--INLINE int-__hscore_ftruncate( int fd, off_t where )-{-#if defined(HAVE_FTRUNCATE)- return ftruncate(fd,where);-#elif defined(HAVE__CHSIZE)- return _chsize(fd,where);-#else-// ToDo: we should use _chsize_s() on Windows which allows a 64-bit-// offset, but it doesn't seem to be available from mingw at this time -// --SDM (01/2008)-#error at least ftruncate or _chsize functions are required to build-#endif-}--#ifndef __UHC__-INLINE int-__hscore_setmode( int fd, HsBool toBin )-{-#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)- return setmode(fd,(toBin == HS_BOOL_TRUE) ? _O_BINARY : _O_TEXT);-#else- return 0;-#endif-}-#endif /* !__UHC__ */--#if __GLASGOW_HASKELL__--INLINE int-__hscore_PrelHandle_write( int fd, void *ptr, HsInt off, int sz )-{- return write(fd,(char *)ptr + off, sz);-}--INLINE int-__hscore_PrelHandle_read( int fd, void *ptr, HsInt off, int sz )-{- return read(fd,(char *)ptr + off, sz);--}--#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)-INLINE int-__hscore_PrelHandle_send( int fd, void *ptr, HsInt off, int sz )-{- return send(fd,(char *)ptr + off, sz, 0);-}--INLINE int-__hscore_PrelHandle_recv( int fd, void *ptr, HsInt off, int sz )-{- return recv(fd,(char *)ptr + off, sz, 0);-}-#endif--#endif /* __GLASGOW_HASKELL__ */--INLINE int-__hscore_mkdir( char *pathName, int mode )-{-#if ( defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) ) && !defined(__CYGWIN__)- return mkdir(pathName);-#else- return mkdir(pathName,mode);-#endif-}--INLINE int-__hscore_lstat( const char *fname, struct stat *st )-{-#if HAVE_LSTAT- return lstat(fname, st);-#else- return stat(fname, st);-#endif-}--INLINE char *-__hscore_d_name( struct dirent* d )-{- return (d->d_name);-}--INLINE int-__hscore_end_of_dir( void )-{- return READDIR_ERRNO_EOF;-}--INLINE void-__hscore_free_dirent(struct dirent *dEnt)-{-#if HAVE_READDIR_R- free(dEnt);-#endif-}--#if defined(__MINGW32__)-// We want the versions of stat/fstat/lseek that use 64-bit offsets,-// and you have to ask for those explicitly. Unfortunately there-// doesn't seem to be a 64-bit version of truncate/ftruncate, so while-// hFileSize and hSeek will work with large files, hSetFileSize will not.-#define stat(file,buf) _stati64(file,buf)-#define fstat(fd,buf) _fstati64(fd,buf)-typedef struct _stati64 struct_stat;-typedef off64_t stsize_t;-#else-typedef struct stat struct_stat;-typedef off_t stsize_t;-#endif--INLINE HsInt-__hscore_sizeof_stat( void )-{- return sizeof(struct_stat);-}--INLINE time_t __hscore_st_mtime ( struct_stat* st ) { return st->st_mtime; }-INLINE stsize_t __hscore_st_size ( struct_stat* st ) { return st->st_size; }-#if !defined(_MSC_VER)-INLINE mode_t __hscore_st_mode ( struct_stat* st ) { return st->st_mode; }-INLINE dev_t __hscore_st_dev ( struct_stat* st ) { return st->st_dev; }-INLINE ino_t __hscore_st_ino ( struct_stat* st ) { return st->st_ino; }-#endif--#if HAVE_TERMIOS_H-INLINE tcflag_t __hscore_lflag( struct termios* ts ) { return ts->c_lflag; }--INLINE void-__hscore_poke_lflag( struct termios* ts, tcflag_t t ) { ts->c_lflag = t; }--INLINE unsigned char*-__hscore_ptr_c_cc( struct termios* ts )-{ return (unsigned char*) &ts->c_cc; }--INLINE HsInt-__hscore_sizeof_termios( void )-{-#ifndef __MINGW32__- return sizeof(struct termios);-#else- return 0;-#endif-}-#endif--//sizeof_sigset_t is also use on windows systems which define tcflat_t. Why exclude it?-// #if !defined(_MSC_VER) && !defined(__MINGW32__) && !defined(_WIN32)-INLINE HsInt-__hscore_sizeof_sigset_t( void )-{- return sizeof(sigset_t);-}-// #endif--INLINE int-__hscore_echo( void )-{-#ifdef ECHO- return ECHO;-#else- return 0;-#endif--}--INLINE int-__hscore_tcsanow( void )-{-#ifdef TCSANOW- return TCSANOW;-#else- return 0;-#endif--}--INLINE int-__hscore_icanon( void )-{-#ifdef ICANON- return ICANON;-#else- return 0;-#endif-}--INLINE int __hscore_vmin( void )-{-#ifdef VMIN- return VMIN;-#else- return 0;-#endif-}--INLINE int __hscore_vtime( void )-{-#ifdef VTIME- return VTIME;-#else- return 0;-#endif-}--INLINE int __hscore_sigttou( void )-{-#ifdef SIGTTOU- return SIGTTOU;-#else- return 0;-#endif-}--INLINE int __hscore_sig_block( void )-{-#ifdef SIG_BLOCK- return SIG_BLOCK;-#else- return 0;-#endif-}--INLINE int __hscore_sig_setmask( void )-{-#ifdef SIG_SETMASK- return SIG_SETMASK;-#else- return 0;-#endif-}--INLINE int-__hscore_f_getfl( void )-{-#ifdef F_GETFL- return F_GETFL;-#else- return 0;-#endif-}--INLINE int-__hscore_f_setfl( void )-{-#ifdef F_SETFL- return F_SETFL;-#else- return 0;-#endif-}--// defined in rts/RtsStartup.c.-extern void* __hscore_get_saved_termios(int fd);-extern void __hscore_set_saved_termios(int fd, void* ts);--INLINE int __hscore_hs_fileno (FILE *f) { return fileno (f); }--INLINE int __hscore_open(char *file, int how, mode_t mode) {-#ifdef __MINGW32__- if ((how & O_WRONLY) || (how & O_RDWR) || (how & O_APPEND))- return _sopen(file,how,_SH_DENYRW,mode);- else- return _sopen(file,how,_SH_DENYWR,mode);-#else- return open(file,how,mode);-#endif-}--// These are wrapped because on some OSs (eg. Linux) they are-// macros which redirect to the 64-bit-off_t versions when large file-// support is enabled.-//-#if defined(__MINGW32__)-INLINE off64_t __hscore_lseek(int fd, off64_t off, int whence) {- return (_lseeki64(fd,off,whence));-}-#else-INLINE off_t __hscore_lseek(int fd, off_t off, int whence) {- return (lseek(fd,off,whence));-}-#endif--INLINE HsInt __hscore_stat(char *file, struct_stat *buf) {- return (stat(file,buf));-}--INLINE HsInt __hscore_fstat(int fd, struct_stat *buf) {- return (fstat(fd,buf));-}--// select-related stuff--#if !defined(__MINGW32__)-INLINE int hsFD_SETSIZE(void) { return FD_SETSIZE; }-INLINE int hsFD_ISSET(int fd, fd_set *fds) { return FD_ISSET(fd, fds); }-INLINE void hsFD_SET(int fd, fd_set *fds) { FD_SET(fd, fds); }-INLINE HsInt sizeof_fd_set(void) { return sizeof(fd_set); }-extern void hsFD_ZERO(fd_set *fds);-#endif--// gettimeofday()-related--#if !defined(__MINGW32__)--INLINE HsInt sizeofTimeVal(void) { return sizeof(struct timeval); }--INLINE HsWord64 getUSecOfDay(void)-{- struct timeval tv;- gettimeofday(&tv, (struct timezone *) NULL);- // Don't forget to cast *before* doing the arithmetic, otherwise- // the arithmetic happens at the type of tv_sec, which is probably- // only 'int'.- return ((HsWord64)tv.tv_sec * 1000000 + (HsWord64)tv.tv_usec);-}--INLINE void setTimevalTicks(struct timeval *p, HsWord64 usecs)-{- p->tv_sec = usecs / 1000000;- p->tv_usec = usecs % 1000000;-}-#endif /* !defined(__MINGW32__) */--/* ToDo: write a feature test that doesn't assume 'environ' to- * be in scope at link-time. */-extern char** environ;-INLINE char **__hscore_environ() { return environ; }--/* lossless conversions between pointers and integral types */-INLINE void * __hscore_from_uintptr(uintptr_t n) { return (void *)n; }-INLINE void * __hscore_from_intptr (intptr_t n) { return (void *)n; }-INLINE uintptr_t __hscore_to_uintptr (void *p) { return (uintptr_t)p; }-INLINE intptr_t __hscore_to_intptr (void *p) { return (intptr_t)p; }--void errorBelch2(const char*s, char *t);-void debugBelch2(const char*s, char *t);--#endif /* __HSBASE_H__ */-
@@ -1,944 +0,0 @@-/* ehclib/uhcbase/include/HsBaseConfig.h. Generated from HsBaseConfig.h.in by configure. */-#ifndef HSBASECONFIG_H-#define HSBASECONFIG_H--#include "MachDeps.h"--/********************************************************************/-/**** Sizes ****/-/********************************************************************/--#if SIZEOF_INTPTR_T == 8-#define HTYPE_INTPTR_T Int64-#define HTYPE_UINTPTR_T Word64-#else-#define HTYPE_INTPTR_T Int32-#define HTYPE_UINTPTR_T Word32-#endif--/* also here: typedef int sig_atomic_t- */-#if SIZEOF_INT == 8-#define HTYPE_INT Int64-#define HTYPE_UNSIGNED_INT Word64-#define HTYPE_SIG_ATOMIC_T Word64-#else-#define HTYPE_INT Int32-#define HTYPE_UNSIGNED_INT Word32-#define HTYPE_SIG_ATOMIC_T Word32-#endif--#if SIZEOF_LONG == 8-#define HTYPE_LONG Int64-#define HTYPE_UNSIGNED_LONG Word64-#else-#define HTYPE_LONG Int32-#define HTYPE_UNSIGNED_LONG Word32-#endif--#if SIZEOF_VOID_P == 8-#define HTYPE_PTRDIFF_T Int64-#else-#define HTYPE_PTRDIFF_T Int32-#endif--#if SIZEOF_CLOCK_T == 8-#define HTYPE_CLOCK_T Word64-#else-#define HTYPE_CLOCK_T Word32-#endif--#if SIZEOF_TIME_T == 8-#define HTYPE_TIME_T Word64-#else-#define HTYPE_TIME_T Word32-#endif--#if SIZEOF_USECONDS_T == 8-#define HTYPE_USECONDS_T Word64-#else-#define HTYPE_USECONDS_T Word32-#endif--#if SIZEOF_SIZE_T == 8-#define HTYPE_SIZE_T Word64-#else-#define HTYPE_SIZE_T Word32-#endif--#if SIZEOF_WCHAR_T == 1-#define HTYPE_WCHAR_T Word8-#elif SIZEOF_WCHAR_T == 2-#define HTYPE_WCHAR_T Word16-#else-#define HTYPE_WCHAR_T Word32-#endif----/* Define to Haskell type for char */-#define HTYPE_CHAR Int8--/* Define to Haskell type for double */-#define HTYPE_DOUBLE Double--/* Define to Haskell type for float */-#define HTYPE_FLOAT Float--/* Define to Haskell type for intmax_t */-#define HTYPE_INTMAX_T Int64--/* Define to Haskell type for long long */-#define HTYPE_LONG_LONG Int64--/* Define to Haskell type for short */-#define HTYPE_SHORT Int16--/* Define to Haskell type for signed char */-#define HTYPE_SIGNED_CHAR Int8--/* Define to Haskell type for uintmax_t */-#define HTYPE_UINTMAX_T Word64--/* Define to Haskell type for unsigned char */-#define HTYPE_UNSIGNED_CHAR Word8--/* Define to Haskell type for unsigned long long */-#define HTYPE_UNSIGNED_LONG_LONG Word64--/* Define to Haskell type for unsigned short */-#define HTYPE_UNSIGNED_SHORT Word16----/********************************************************************/-/**** System tupes ****/-/********************************************************************/--#ifdef SIZEOF_DEV_T-# if SIZEOF_DEV_T == 8-# define HTYPE_DEV_T Word64-# elif SIZEOF_DEV_T == 4-# define HTYPE_DEV_T Word32-# elif SIZEOF_DEV_T == 2-# define HTYPE_DEV_T Word16-# else-# endif-#endif--#ifdef SIZEOF_INO_T-# if SIZEOF_INO_T == 8-# define HTYPE_INO_T Word64-# elif SIZEOF_INO_T == 4-# define HTYPE_INO_T Word32-# elif SIZEOF_INO_T == 2-# define HTYPE_INO_T Word16-# else-# endif-#endif--#ifdef SIZEOF_MODE_T-# if SIZEOF_MODE_T == 8-# define HTYPE_MODE_T Word64-# elif SIZEOF_MODE_T == 4-# define HTYPE_MODE_T Word32-# elif SIZEOF_MODE_T == 2-# define HTYPE_MODE_T Word16-# else-# endif-#endif--#ifdef SIZEOF_OFF_T-# if SIZEOF_OFF_T == 8-# define HTYPE_OFF_T Word64-# elif SIZEOF_OFF_T == 4-# define HTYPE_OFF_T Word32-# elif SIZEOF_OFF_T == 2-# define HTYPE_OFF_T Word16-# else-# endif-#endif--#ifdef SIZEOF_PID_T-# if SIZEOF_PID_T == 8-# define HTYPE_PID_T Word64-# elif SIZEOF_PID_T == 4-# define HTYPE_PID_T Word32-# elif SIZEOF_PID_T == 2-# define HTYPE_PID_T Word16-# else-# endif-#endif--#ifdef SIZEOF_SSIZE_T-# if SIZEOF_SSIZE_T == 8-# define HTYPE_SSIZE_T Word64-# elif SIZEOF_SSIZE_T == 4-# define HTYPE_SSIZE_T Word32-# elif SIZEOF_SSIZE_T == 2-# define HTYPE_SSIZE_T Word16-# else-# endif-#endif--#ifdef SIZEOF_GID_T-# if SIZEOF_GID_T == 8-# define HTYPE_GID_T Word64-# elif SIZEOF_GID_T == 4-# define HTYPE_GID_T Word32-# elif SIZEOF_GID_T == 2-# define HTYPE_GID_T Word16-# else-# endif-#endif--#ifdef SIZEOF_NLINK_T-# if SIZEOF_NLINK_T == 8-# define HTYPE_NLINK_T Word64-# elif SIZEOF_NLINK_T == 4-# define HTYPE_NLINK_T Word32-# elif SIZEOF_NLINK_T == 2-# define HTYPE_NLINK_T Word16-# else-# endif-#endif--#ifdef SIZEOF_UID_T-# if SIZEOF_UID_T == 8-# define HTYPE_UID_T Word64-# elif SIZEOF_UID_T == 4-# define HTYPE_UID_T Word32-# elif SIZEOF_UID_T == 2-# define HTYPE_UID_T Word16-# else-# endif-#endif--#ifdef SIZEOF_CC_T-# if SIZEOF_CC_T == 8-# define HTYPE_CC_T Word64-# elif SIZEOF_CC_T == 4-# define HTYPE_CC_T Word32-# elif SIZEOF_CC_T == 2-# define HTYPE_CC_T Word16-# else-# endif-#endif--#ifdef SIZEOF_SPEED_T-# if SIZEOF_SPEED_T == 8-# define HTYPE_SPEED_T Word64-# elif SIZEOF_SPEED_T == 4-# define HTYPE_SPEED_T Word32-# elif SIZEOF_SPEED_T == 2-# define HTYPE_SPEED_T Word16-# else-# endif-#endif--#ifdef SIZEOF_TCFLAG_T-# if SIZEOF_TCFLAG_T == 8-# define HTYPE_TCFLAG_T Word64-# elif SIZEOF_TCFLAG_T == 4-# define HTYPE_TCFLAG_T Word32-# elif SIZEOF_TCFLAG_T == 2-# define HTYPE_TCFLAG_T Word16-# else-# endif-#endif--#ifdef SIZEOF_RLIM_T-# if SIZEOF_RLIM_T == 8-# define HTYPE_RLIM_T Word64-# elif SIZEOF_RLIM_T == 4-# define HTYPE_RLIM_T Word32-# elif SIZEOF_RLIM_T == 2-# define HTYPE_RLIM_T Word16-# else-# endif-#endif--/********************************************************************/-/**** Presence of include files ****/-/********************************************************************/--#define HAVE_DIRENT_H 1-#define HAVE_ERRNO_H 1-#define HAVE_FCNTL_H 1-#define HAVE_INTTYPES_H 1-#define HAVE_LIMITS_H 1-#define HAVE_SIGNAL_H 1-#define HAVE_STDINT_H 1-#define HAVE_STRING_H 1-#define HAVE_SYS_RESOURCE_H 1-#define HAVE_SYS_SELECT_H 1-#define HAVE_SYS_STAT_H 1-#define HAVE_SYS_SYSCALL_H 1-#define HAVE_SYS_TIME_H 1-#define HAVE_SYS_TIMEB_H 1-/* #undef HAVE_SYS_TIMERS_H */-#define HAVE_SYS_TIMES_H 1-#define HAVE_SYS_TYPES_H 1-#define HAVE_SYS_UTSNAME_H 1-#define HAVE_SYS_WAIT_H 1-#define HAVE_TERMIOS_H 1-#define HAVE_TIME_H 1-#define HAVE_UNISTD_H 1-#define HAVE_UTIME_H 1-/* #undef HAVE_VFORK_H */-#define HAVE_WCTYPE_H 1-/* #undef HAVE_WINDOWS_H */-/* #undef HAVE_WINSOCK_H */--/* #undef HAVE__CHSIZE */-#define HAVE_FTRUNCATE 1-/* #undef HAVE_GETCLOCK */-#define HAVE_GETRUSAGE 1-#define HAVE_GETTIMEOFDAY 1-#define HAVE_LSTAT 1-#define HAVE_READDIR_R 1--/********************************************************************/-/**** Runtime types ****/-/********************************************************************/--#ifdef __UHC_BUILDS_O__--#if defined(__UHC_TARGET_BC__) || defined(__UHC_TARGET_C__)-// # define HsBool Word-// # define HsInt Word-// # define HsWord64 Word64-// # define HsWord32 Word32-// # define HsWord16 Word16-// # define HsWord8 Word8-// # ifdef __UHC_TARGET_BC__-// # define HS_BOOL_FALSE gb_False-// # define HS_BOOL_TRUE gb_True-// # else-// # define HS_BOOL_FALSE 0-// # define HS_BOOL_TRUE 1-// # endif-#endif /* __UHC_TARGET_BC__ */--#endif /* __UHC_BUILDS_O__ */--/********************************************************************/-/**** Read dir EOF error ****/-/********************************************************************/--/* See remarks in GHC, libraries/base/aclocal.m4: MinGW platform returns non 0 value. We ignore that */-#define READDIR_ERRNO_EOF 0--/********************************************************************/-/**** C errors ****/-/********************************************************************/--/* (1) Assume errno.h is already included */-/* (2) Error codes like EADV are not present on all platforms, so a dummy value is provided, this should be done for all codes */--/* The value of E2BIG. */-#if !defined(E2BIG)-#define E2BIG 10000-#endif-#define CONST_E2BIG E2BIG--/* The value of EACCES. */-#if !defined(EACCES)-#define EACCES 10000-#endif-#define CONST_EACCES EACCES--/* The value of EADDRINUSE. */-#if !defined(EADDRINUSE)-#define EADDRINUSE 10000-#endif-#define CONST_EADDRINUSE EADDRINUSE--/* The value of EADDRNOTAVAIL. */-#define CONST_EADDRNOTAVAIL EADDRNOTAVAIL--/* The value of EADV. */-#if !defined(EADV)-#define EADV 10000-#endif-#define CONST_EADV EADV--/* The value of EAFNOSUPPORT. */-#if !defined(EAFNOSUPPORT)-#define EAFNOSUPPORT 10000-#endif-#define CONST_EAFNOSUPPORT EAFNOSUPPORT--/* The value of EAGAIN. */-#if !defined(EAGAIN)-#define EAGAIN 10000-#endif-#define CONST_EAGAIN EAGAIN--/* The value of EALREADY. */-#if !defined(EALREADY)-#define EALREADY 10000-#endif-#define CONST_EALREADY EALREADY--/* The value of EBADF. */-#if !defined(EBADF)-#define EBADF 10000-#endif-#define CONST_EBADF EBADF--/* The value of EBADMSG. */-#if !defined(EBADMSG)-#define EBADMSG 10000-#endif-#define CONST_EBADMSG EBADMSG--/* The value of EBADRPC. */-#if !defined(EBADRPC)-#define EBADRPC 10000-#endif-#define CONST_EBADRPC EBADRPC--/* The value of EBUSY. */-#if !defined(EBUSY)-#define EBUSY 10000-#endif-#define CONST_EBUSY EBUSY--/* The value of ECHILD. */-#if !defined(ECHILD)-#define ECHILD 10000-#endif-#define CONST_ECHILD ECHILD--/* The value of ECOMM. */-#if !defined(ECOMM)-#define ECOMM 10000-#endif-#define CONST_ECOMM ECOMM--/* The value of ECONNABORTED. */-#if !defined(ECONNABORTED)-#define ECONNABORTED 10000-#endif-#define CONST_ECONNABORTED ECONNABORTED--/* The value of ECONNREFUSED. */-#if !defined(ECONNREFUSED)-#define ECONNREFUSED 10000-#endif-#define CONST_ECONNREFUSED ECONNREFUSED--/* The value of ECONNRESET. */-#if !defined(ECONNRESET)-#define ECONNRESET 10000-#endif-#define CONST_ECONNRESET ECONNRESET--/* The value of EDEADLK. */-#if !defined(EDEADLK)-#define EDEADLK 10000-#endif-#define CONST_EDEADLK EDEADLK--/* The value of EDESTADDRREQ. */-#if !defined(EDESTADDRREQ)-#define EDESTADDRREQ 10000-#endif-#define CONST_EDESTADDRREQ EDESTADDRREQ--/* The value of EDIRTY. */-#if !defined(EDIRTY)-#define EDIRTY 10000-#endif-#define CONST_EDIRTY EDIRTY--/* The value of EDOM. */-#if !defined(EDOM)-#define EDOM 10000-#endif-#define CONST_EDOM EDOM--/* The value of EDQUOT. */-#if !defined(EDQUOT)-#define EDQUOT 10000-#endif-#define CONST_EDQUOT EDQUOT--/* The value of EEXIST. */-#if !defined(EEXIST)-#define EEXIST 10000-#endif-#define CONST_EEXIST EEXIST--/* The value of EFAULT. */-#if !defined(EFAULT)-#define EFAULT 10000-#endif-#define CONST_EFAULT EFAULT--/* The value of EFBIG. */-#if !defined(EFBIG)-#define EFBIG 10000-#endif-#define CONST_EFBIG EFBIG--/* The value of EFTYPE. */-#if !defined(EFTYPE)-#define EFTYPE 10000-#endif-#define CONST_EFTYPE EFTYPE--/* The value of EHOSTDOWN. */-#if !defined(EHOSTDOWN)-#define EHOSTDOWN 10000-#endif-#define CONST_EHOSTDOWN EHOSTDOWN--/* The value of EHOSTUNREACH. */-#if !defined(EHOSTUNREACH)-#define EHOSTUNREACH 10000-#endif-#define CONST_EHOSTUNREACH EHOSTUNREACH--/* The value of EIDRM. */-#if !defined(EIDRM)-#define EIDRM 10000-#endif-#define CONST_EIDRM EIDRM--/* The value of EILSEQ. */-#if !defined(EILSEQ)-#define EILSEQ 10000-#endif-#define CONST_EILSEQ EILSEQ--/* The value of EINPROGRESS. */-#if !defined(EINPROGRESS)-#define EINPROGRESS 10000-#endif-#define CONST_EINPROGRESS EINPROGRESS--/* The value of EINTR. */-#if !defined(EINTR)-#define EINTR 10000-#endif-#define CONST_EINTR EINTR--/* The value of EINVAL. */-#if !defined(EINVAL)-#define EINVAL 10000-#endif-#define CONST_EINVAL EINVAL--/* The value of EIO. */-#if !defined(EIO)-#define EIO 10000-#endif-#define CONST_EIO EIO--/* The value of EISCONN. */-#if !defined(EISCONN)-#define EISCONN 10000-#endif-#define CONST_EISCONN EISCONN--/* The value of EISDIR. */-#if !defined(EISDIR)-#define EISDIR 10000-#endif-#define CONST_EISDIR EISDIR--/* The value of ELOOP. */-#if !defined(ELOOP)-#define ELOOP 10000-#endif-#define CONST_ELOOP ELOOP--/* The value of EMFILE. */-#if !defined(EMFILE)-#define EMFILE 10000-#endif-#define CONST_EMFILE EMFILE--/* The value of EMLINK. */-#if !defined(EMLINK)-#define EMLINK 10000-#endif-#define CONST_EMLINK EMLINK--/* The value of EMSGSIZE. */-#if !defined(EMSGSIZE)-#define EMSGSIZE 10000-#endif-#define CONST_EMSGSIZE EMSGSIZE--/* The value of EMULTIHOP. */-#if !defined(EMULTIHOP)-#define EMULTIHOP 10000-#endif-#define CONST_EMULTIHOP EMULTIHOP--/* The value of ENAMETOOLONG. */-#if !defined(ENAMETOOLONG)-#define ENAMETOOLONG 10000-#endif-#define CONST_ENAMETOOLONG ENAMETOOLONG--/* The value of ENETDOWN. */-#if !defined(ENETDOWN)-#define ENETDOWN 10000-#endif-#define CONST_ENETDOWN ENETDOWN--/* The value of ENETRESET. */-#if !defined(ENETRESET)-#define ENETRESET 10000-#endif-#define CONST_ENETRESET ENETRESET--/* The value of ENETUNREACH. */-#if !defined(ENETUNREACH)-#define ENETUNREACH 10000-#endif-#define CONST_ENETUNREACH ENETUNREACH--/* The value of ENFILE. */-#if !defined(ENFILE)-#define ENFILE 10000-#endif-#define CONST_ENFILE ENFILE--/* The value of ENOBUFS. */-#if !defined(ENOBUFS)-#define ENOBUFS 10000-#endif-#define CONST_ENOBUFS ENOBUFS--/* The value of ENOCIGAR. */-#if !defined(ENOCIGAR)-#define ENOCIGAR 10000-#endif-#define CONST_ENOCIGAR ENOCIGAR--/* The value of ENODATA. */-#if !defined(ENODATA)-#define ENODATA 10000-#endif-#define CONST_ENODATA ENODATA--/* The value of ENODEV. */-#if !defined(ENODEV)-#define ENODEV 10000-#endif-#define CONST_ENODEV ENODEV--/* The value of ENOENT. */-#if !defined(ENOENT)-#define ENOENT 10000-#endif-#define CONST_ENOENT ENOENT--/* The value of ENOEXEC. */-#if !defined(ENOEXEC)-#define ENOEXEC 10000-#endif-#define CONST_ENOEXEC ENOEXEC--/* The value of ENOLCK. */-#if !defined(ENOLCK)-#define ENOLCK 10000-#endif-#define CONST_ENOLCK ENOLCK--/* The value of ENOLINK. */-#if !defined(ENOLINK)-#define ENOLINK 10000-#endif-#define CONST_ENOLINK ENOLINK--/* The value of ENOMEM. */-#if !defined(ENOMEM)-#define ENOMEM 10000-#endif-#define CONST_ENOMEM ENOMEM--/* The value of ENOMSG. */-#if !defined(ENOMSG)-#define ENOMSG 10000-#endif-#define CONST_ENOMSG ENOMSG--/* The value of ENONET. */-#if !defined(ENONET)-#define ENONET 10000-#endif-#define CONST_ENONET ENONET--/* The value of ENOPROTOOPT. */-#if !defined(ENOPROTOOPT)-#define ENOPROTOOPT 10000-#endif-#define CONST_ENOPROTOOPT ENOPROTOOPT--/* The value of ENOSPC. */-#if !defined(ENOSPC)-#define ENOSPC 10000-#endif-#define CONST_ENOSPC ENOSPC--/* The value of ENOSR. */-#if !defined(ENOSR)-#define ENOSR 10000-#endif-#define CONST_ENOSR ENOSR--/* The value of ENOSTR. */-#if !defined(ENOSTR)-#define ENOSTR 10000-#endif-#define CONST_ENOSTR ENOSTR--/* The value of ENOSYS. */-#if !defined(ENOSYS)-#define ENOSYS 10000-#endif-#define CONST_ENOSYS ENOSYS--/* The value of ENOTBLK. */-#if !defined(ENOTBLK)-#define ENOTBLK 10000-#endif-#define CONST_ENOTBLK ENOTBLK--/* The value of ENOTCONN. */-#if !defined(ENOTCONN)-#define ENOTCONN 10000-#endif-#define CONST_ENOTCONN ENOTCONN--/* The value of ENOTDIR. */-#if !defined(ENOTDIR)-#define ENOTDIR 10000-#endif-#define CONST_ENOTDIR ENOTDIR--/* The value of ENOTEMPTY. */-#if !defined(ENOTEMPTY)-#define ENOTEMPTY 10000-#endif-#define CONST_ENOTEMPTY ENOTEMPTY--/* The value of ENOTSOCK. */-#if !defined(ENOTSOCK)-#define ENOTSOCK 10000-#endif-#define CONST_ENOTSOCK ENOTSOCK--/* The value of ENOTTY. */-#if !defined(ENOTTY)-#define ENOTTY 10000-#endif-#define CONST_ENOTTY ENOTTY--/* The value of ENXIO. */-#if !defined(ENXIO)-#define ENXIO 10000-#endif-#define CONST_ENXIO ENXIO--/* The value of EOPNOTSUPP. */-#if !defined(EOPNOTSUPP)-#define EOPNOTSUPP 10000-#endif-#define CONST_EOPNOTSUPP EOPNOTSUPP--/* The value of EPERM. */-#if !defined(EPERM)-#define EPERM 10000-#endif-#define CONST_EPERM EPERM--/* The value of EPFNOSUPPORT. */-#if !defined(EPFNOSUPPORT)-#define EPFNOSUPPORT 10000-#endif-#define CONST_EPFNOSUPPORT EPFNOSUPPORT--/* The value of EPIPE. */-#if !defined(EPIPE)-#define EPIPE 10000-#endif-#define CONST_EPIPE EPIPE--/* The value of EPROCLIM. */-#if !defined(EPROCLIM)-#define EPROCLIM 10000-#endif-#define CONST_EPROCLIM EPROCLIM--/* The value of EPROCUNAVAIL. */-#if !defined(EPROCUNAVAIL)-#define EPROCUNAVAIL 10000-#endif-#define CONST_EPROCUNAVAIL EPROCUNAVAIL--/* The value of EPROGMISMATCH. */-#if !defined(EPROGMISMATCH)-#define EPROGMISMATCH 10000-#endif-#define CONST_EPROGMISMATCH EPROGMISMATCH--/* The value of EPROGUNAVAIL. */-#if !defined(EPROGUNAVAIL)-#define EPROGUNAVAIL 10000-#endif-#define CONST_EPROGUNAVAIL EPROGUNAVAIL--/* The value of EPROTO. */-#if !defined(EPROTO)-#define EPROTO 10000-#endif-#define CONST_EPROTO EPROTO--/* The value of EPROTONOSUPPORT. */-#if !defined(EPROTONOSUPPORT)-#define EPROTONOSUPPORT 10000-#endif-#define CONST_EPROTONOSUPPORT EPROTONOSUPPORT--/* The value of EPROTOTYPE. */-#if !defined(EPROTOTYPE)-#define EPROTOTYPE 10000-#endif-#define CONST_EPROTOTYPE EPROTOTYPE--/* The value of ERANGE. */-#if !defined(ERANGE)-#define ERANGE 10000-#endif-#define CONST_ERANGE ERANGE--/* The value of EREMCHG. */-#if !defined(EREMCHG)-#define EREMCHG 10000-#endif-#define CONST_EREMCHG EREMCHG--/* The value of EREMOTE. */-#if !defined(EREMOTE)-#define EREMOTE 10000-#endif-#define CONST_EREMOTE EREMOTE--/* The value of EROFS. */-#if !defined(EROFS)-#define EROFS 10000-#endif-#define CONST_EROFS EROFS--/* The value of ERPCMISMATCH. */-#if !defined(ERPCMISMATCH)-#define ERPCMISMATCH 10000-#endif-#define CONST_ERPCMISMATCH ERPCMISMATCH--/* The value of ERREMOTE. */-#if !defined(ERREMOTE)-#define ERREMOTE 10000-#endif-#define CONST_ERREMOTE ERREMOTE--/* The value of ESHUTDOWN. */-#if !defined(ESHUTDOWN)-#define ESHUTDOWN 10000-#endif-#define CONST_ESHUTDOWN ESHUTDOWN--/* The value of ESOCKTNOSUPPORT. */-#if !defined(ESOCKTNOSUPPORT)-#define ESOCKTNOSUPPORT 10000-#endif-#define CONST_ESOCKTNOSUPPORT ESOCKTNOSUPPORT--/* The value of ESPIPE. */-#if !defined(ESPIPE)-#define ESPIPE 10000-#endif-#define CONST_ESPIPE ESPIPE--/* The value of ESRCH. */-#if !defined(ESRCH)-#define ESRCH 10000-#endif-#define CONST_ESRCH ESRCH--/* The value of ESRMNT. */-#if !defined(ESRMNT)-#define ESRMNT 10000-#endif-#define CONST_ESRMNT ESRMNT--/* The value of ESTALE. */-#if !defined(ESTALE)-#define ESTALE 10000-#endif-#define CONST_ESTALE ESTALE--/* The value of ETIME. */-#if !defined(ETIME)-#define ETIME 10000-#endif-#define CONST_ETIME ETIME--/* The value of ETIMEDOUT. */-#if !defined(ETIMEDOUT)-#define ETIMEDOUT 10000-#endif-#define CONST_ETIMEDOUT ETIMEDOUT--/* The value of ETOOMANYREFS. */-#if !defined(ETOOMANYREFS)-#define ETOOMANYREFS 10000-#endif-#define CONST_ETOOMANYREFS ETOOMANYREFS--/* The value of ETXTBSY. */-#if !defined(ETXTBSY)-#define ETXTBSY 10000-#endif-#define CONST_ETXTBSY ETXTBSY--/* The value of EUSERS. */-#if !defined(EUSERS)-#define EUSERS 10000-#endif-#define CONST_EUSERS EUSERS--/* The value of EWOULDBLOCK. */-#if !defined(EWOULDBLOCK)-#define EWOULDBLOCK 10000-#endif-#define CONST_EWOULDBLOCK EWOULDBLOCK--/* The value of EXDEV. */-#if !defined(EXDEV)-#define EXDEV 10000-#endif-#define CONST_EXDEV EXDEV--/* The value of O_BINARY. */-#if !defined(O_BINARY)-#define O_BINARY 10000-#endif-#define CONST_O_BINARY O_BINARY--/* The value of SIGINT. */-#if !defined(SIGINT)-#define SIGINT 10000-#endif-#define CONST_SIGINT SIGINT---#endif-
@@ -1,242 +0,0 @@-{- ---------------------------------------------------------------------------// Macros to help make various instances for Int like types (Int8, ...).-//-// Primitives are defined by 2 forms of macros:-// - starting with PRIMS_ : name of Haskell function and primitive is the same-// - starting with PRIMS2_ : name of primitive is given explicitly, to allow sharing between primitives-// ----------------------------------------------------------------------------}---- define conversion primitives-#define PRIMS_CONVERSION_INTEGER(tycon,primIntegerTo,primToInteger) \-foreign import prim primIntegerTo :: Integer -> tycon ; \-foreign import prim primToInteger :: tycon -> Integer --#define PRIMS2_CONVERSION_INTEGER(tycon,primIntegerTo,primIntegerToNm,primToInteger,primToIntegerNm) \-foreign import prim primIntegerToNm primIntegerTo :: Integer -> tycon ; \-foreign import prim primToIntegerNm primToInteger :: tycon -> Integer --#define PRIMS_CONVERSION_INT(tycon,primIntTo,primToInt) \-foreign import prim primIntTo :: Int -> tycon ; \-foreign import prim primToInt :: tycon -> Int ----- define Eq primitives-#define PRIMS_EQ(tycon,primEq,primNe) \-foreign import prim primEq :: tycon -> tycon -> Bool ; \-foreign import prim primNe :: tycon -> tycon -> Bool --#define PRIMS2_EQ(tycon,primEq,primEqNm,primNe,primNeNm) \-foreign import prim primEqNm primEq :: tycon -> tycon -> Bool ; \-foreign import prim primNeNm primNe :: tycon -> tycon -> Bool----- define Eq instance-#define INSTANCE_EQ(tycon,primEq,primNe) \-instance Eq tycon where \- { (==) = primEq ; \- (/=) = primNe \- }----- define Ord primitives--#define PRIMS_ORD(tycon,primCmp,primLt,primGt,primLe,primGe) \-foreign import prim primCmp :: tycon -> tycon -> Ordering ; \-foreign import prim primLt :: tycon -> tycon -> Bool ; \-foreign import prim primGt :: tycon -> tycon -> Bool ; \-foreign import prim primLe :: tycon -> tycon -> Bool ; \-foreign import prim primGe :: tycon -> tycon -> Bool --#define PRIMS2_ORD(tycon,primCmp,primCmpNm,primLt,primLtNm,primGt,primGtNm,primLe,primLeNm,primGe,primGeNm) \-foreign import prim primCmpNm primCmp :: tycon -> tycon -> Ordering ; \-foreign import prim primLtNm primLt :: tycon -> tycon -> Bool ; \-foreign import prim primGtNm primGt :: tycon -> tycon -> Bool ; \-foreign import prim primLeNm primLe :: tycon -> tycon -> Bool ; \-foreign import prim primGeNm primGe :: tycon -> tycon -> Bool ----- define Ord instance--#define INSTANCE_ORD(tycon,primCmp,primLt,primGt,primLe,primGe) \-instance Ord tycon where \- { compare = primCmp \- ; (<) = primLt \- ; (>) = primGt \- ; (<=) = primLe \- ; (>=) = primGe \- }----- define Bounded primitives-#define PRIMS_BOUNDED(tycon,primMin,primMax) \-foreign import prim primMin :: tycon ; \-foreign import prim primMax :: tycon ----- define Bounded instance-#define INSTANCE_BOUNDED(tycon,primMin,primMax) \-instance Bounded tycon where \- { minBound = primMin \- ; maxBound = primMax \- }----- define Num primitives-#define PRIMS_NUM(tycon,primAdd,primSub,primMul,primNeg) \-foreign import prim primAdd :: tycon -> tycon -> tycon ; \-foreign import prim primSub :: tycon -> tycon -> tycon ; \-foreign import prim primMul :: tycon -> tycon -> tycon ; \-foreign import prim primNeg :: tycon -> tycon --#define PRIMS2_NUM(tycon,primAdd,primAddNm,primSub,primSubNm,primMul,primMulNm,primNeg,primNegNm) \-foreign import prim primAddNm primAdd :: tycon -> tycon -> tycon ; \-foreign import prim primSubNm primSub :: tycon -> tycon -> tycon ; \-foreign import prim primMulNm primMul :: tycon -> tycon -> tycon ; \-foreign import prim primNegNm primNeg :: tycon -> tycon ----- define Num instance-#define INSTANCE_NUM(tycon,primAdd,primSub,primMul,primNeg,primIntegerTo,primIntTo) \-instance Num tycon where \- { (+) = primAdd \- ; (-) = primSub \- ; (*) = primMul \- ; negate = primNeg \- ; fromInteger = primIntegerTo \- ; fromInt = primIntTo \- ; abs = absReal \- ; signum = signumReal \- }----- define Enum instance-#define INSTANCE_ENUM(tycon,primToEnum,primFromEnum) \-instance Enum tycon where \- { succ = boundedSucc \- ; pred = boundedPred \- ; toEnum = primToEnum \- ; fromEnum = primFromEnum \- ; enumFrom = boundedEnumFrom \- ; enumFromTo = boundedEnumFromTo \- ; enumFromThen = boundedEnumFromThen \- ; enumFromThenTo = boundedEnumFromThenTo \- }----- define Real instance-#define INSTANCE_REAL(tycon) \-instance Real tycon where \- { toRational x = toInteger x % 1 \- }----- define Integral primitives-#define PRIMS_INTEGRAL1(tycon,primDiv,primMod,primQuot,primRem) \-foreign import prim primDiv :: tycon -> tycon -> tycon ; \-foreign import prim primMod :: tycon -> tycon -> tycon ; \-foreign import prim primQuot :: tycon -> tycon -> tycon ; \-foreign import prim primRem :: tycon -> tycon -> tycon --#define PRIMS2_INTEGRAL1(tycon,primDiv,primDivNm,primMod,primModNm,primQuot,primQuotNm,primRem,primRemNm) \-foreign import prim primDivNm primDiv :: tycon -> tycon -> tycon ; \-foreign import prim primModNm primMod :: tycon -> tycon -> tycon ; \-foreign import prim primQuotNm primQuot :: tycon -> tycon -> tycon ; \-foreign import prim primRemNm primRem :: tycon -> tycon -> tycon --#define PRIMS_INTEGRAL2(tycon,primDiv,primMod,primDivMod,primQuot,primRem,primQuotRem) \-PRIMS_INTEGRAL1(tycon,primDiv,primMod,primQuot,primRem) ; \-foreign import prim primDivMod :: tycon -> tycon -> (tycon,tycon) ; \-foreign import prim primQuotRem :: tycon -> tycon -> (tycon,tycon) --#define PRIMS2_INTEGRAL2(tycon,primDiv,primDivNm,primMod,primModNm,primDivMod,primDivModNm,primQuot,primQuotNm,primRem,primRemNm,primQuotRem,primQuotRemNm) \-PRIMS2_INTEGRAL1(tycon,primDiv,primDivNm,primMod,primModNm,primQuot,primQuotNm,primRem,primQuotRemNm) ; \-foreign import prim primDivModNm primDivMod :: tycon -> tycon -> (tycon,tycon) ; \-foreign import prim primQuotRemNm primQuotRem :: tycon -> tycon -> (tycon,tycon) ----- define Integral instance, assume default for divMod-#define INSTANCE_INTEGRAL1(tycon,primDiv,primMod,primQuot,primRem,primToInteger,primToInt) \-instance Integral tycon where \- { quotRem d m \- = (primQuot d m, primRem d m) \- ; div = primDiv \- ; quot = primQuot \- ; rem = primRem \- ; mod = primMod \- ; toInteger = primToInteger \- ; toInt = primToInt \- }--#define INSTANCE_INTEGRAL2(tycon,primDiv,primMod,primDivMod,primQuot,primRem,primQuotRem,primToInteger,primToInt) \-instance Integral tycon where \- { divMod = primDivMod \- ; quotRem = primQuotRem \- ; div = primDiv \- ; quot = primQuot \- ; rem = primRem \- ; mod = primMod \- ; toInteger = primToInteger \- ; toInt = primToInt \- }----- define Show instance-#define INSTANCE_SHOW(tycon) \-instance Show tycon where \- { show = show . toInteger \- }----- define Read instance-#define INSTANCE_READ(tycon) \-instance Read tycon where \- { readsPrec p = readSigned readDec \- }----- define Bits primitives-#define PRIMS_BITLOGIC(tycon,primAnd,primOr,primXor) \-foreign import prim primAnd :: tycon -> tycon -> tycon ; \-foreign import prim primOr :: tycon -> tycon -> tycon ; \-foreign import prim primXor :: tycon -> tycon -> tycon--#define PRIMS_BITSHIFT(tycon,primComplement,primShiftLeft,primShiftRight,primRotateLeft,primRotateRight) \-foreign import prim primComplement :: tycon -> tycon ; \-foreign import prim primShiftLeft :: tycon -> Int -> tycon ; \-foreign import prim primShiftRight :: tycon -> Int -> tycon ; \-foreign import prim primRotateLeft :: tycon -> Int -> tycon ; \-foreign import prim primRotateRight :: tycon -> Int -> tycon--#define PRIMS2_BITLOGIC(tycon,primAnd,primAndNm,primOr,primOrNm,primXor,primXorNm) \-foreign import prim primAndNm primAnd :: tycon -> tycon -> tycon ; \-foreign import prim primOrNm primOr :: tycon -> tycon -> tycon ; \-foreign import prim primXorNm primXor :: tycon -> tycon -> tycon--#define PRIMS2_BITSHIFT(tycon,primComplement,primComplementNm,primShiftLeft,primShiftLeftNm,primShiftRight,primShiftRightNm,primRotateLeft,primRotateLeftNm,primRotateRight,primRotateRightNm) \-foreign import prim primComplementNm primComplement :: tycon -> tycon ; \-foreign import prim primShiftLeftNm primShiftLeft :: tycon -> Int -> tycon ; \-foreign import prim primShiftRightNm primShiftRight :: tycon -> Int -> tycon ; \-foreign import prim primRotateLeftNm primRotateLeft :: tycon -> Int -> tycon ; \-foreign import prim primRotateRightNm primRotateRight :: tycon -> Int -> tycon---- define Bits instance-#define INSTANCE_BITS1(tycon,size,signed,primAnd,primOr,primXor,primComplement,primShiftLeft,primShiftRight,primRotateLeft,primRotateRight) \-instance Bits tycon where \- { (.&.) = primAnd \- ; (.|.) = primOr \- ; xor = primXor \- ; complement = primComplement \- ; shiftL = primShiftLeft \- ; shiftR = primShiftRight \- ; rotateL = primRotateLeft \- ; rotateR = primRotateRight \- ; bitSize _ = size \- ; isSigned _ = signed \- }------
@@ -1,125 +0,0 @@-/* ehclib/uhcbase/include/MachDeps.h. Generated from MachDeps.h.in by configure. */-#ifndef MACHDEPS_H-#define MACHDEPS_H--#define SIZEOF_INTPTR_T 8-#define SIZEOF_CHAR 1-#define SIZEOF_SHORT 2-#define SIZEOF_INT 4-#define SIZEOF_LONG 8-#define SIZEOF_LONG_LONG 8-#define SIZEOF_FLOAT 4-#define SIZEOF_DOUBLE 8-#define SIZEOF_UNSIGNED_CHAR 1-#define SIZEOF_UNSIGNED_SHORT 2-#define SIZEOF_UNSIGNED_INT 4-#define SIZEOF_UNSIGNED_LONG 8-#define SIZEOF_UNSIGNED_LONG_LONG 8-#define SIZEOF_VOID_P 8--#define SIZEOF_DEV_T 4-#define SIZEOF_INO_T 8-#define SIZEOF_OFF_T 8-#define SIZEOF_MODE_T 2-#define SIZEOF_PID_T 4-#define SIZEOF_SSIZE_T 8-#define SIZEOF_GID_T 4-#define SIZEOF_NLINK_T 2-#define SIZEOF_UID_T 4-#define SIZEOF_RLIM_T 8-#define SIZEOF_CLOCK_T 8-#define SIZEOF_TIME_T 8-#define SIZEOF_SIZE_T 8-#define SIZEOF_WCHAR_T 4--#define SIZEOF_CC_T 1-#define SIZEOF_SPEED_T 8-#define SIZEOF_TCFLAG_T 8--#define ALIGNOF_INTPTR_T 8-#define ALIGNOF_CHAR 1-#define ALIGNOF_SHORT 2-#define ALIGNOF_INT 4-#define ALIGNOF_LONG 8-#define ALIGNOF_LONG_LONG 8-#define ALIGNOF_FLOAT 4-#define ALIGNOF_DOUBLE 8-#define ALIGNOF_UNSIGNED_CHAR 1-#define ALIGNOF_UNSIGNED_SHORT 2-#define ALIGNOF_UNSIGNED_INT 4-#define ALIGNOF_UNSIGNED_LONG 8-#define ALIGNOF_UNSIGNED_LONG_LONG 8-#define ALIGNOF_VOID_P 8--#define ALIGNOF_UINT8_T 1-#define ALIGNOF_UINT16_T 2-#define ALIGNOF_UINT32_T 4-#define ALIGNOF_UINT64_T 8--#if SIZEOF_INTPTR_T == 8-#define USE_64_BITS 1-#define USE_32_BITS 0-#else-#define USE_64_BITS 0-#define USE_32_BITS 1-#endif--#ifdef __UHC_TARGET_BC__-#define BITSIZEOF_WORDTAG 1-#else-#define BITSIZEOF_WORDTAG 0-#endif--#define SIZEOF_HSCHAR SIZEOF_INTPTR_T-#define ALIGNMENT_HSCHAR ALIGNOF_UINT32_T--#define SIZEOF_HSINT SIZEOF_INTPTR_T-#define ALIGNMENT_HSINT ALIGNOF_INTPTR_T--#define SIZEOF_HSWORD SIZEOF_INTPTR_T-#define ALIGNMENT_HSWORD ALIGNOF_INTPTR_T--#define SIZEOF_HSDOUBLE SIZEOF_DOUBLE-#define ALIGNMENT_HSDOUBLE ALIGNOF_DOUBLE--#define SIZEOF_HSFLOAT SIZEOF_FLOAT-#define ALIGNMENT_HSFLOAT ALIGNOF_FLOAT--#define SIZEOF_HSPTR SIZEOF_VOID_P-#define ALIGNMENT_HSPTR ALIGNOF_VOID_P--#define SIZEOF_HSFUNPTR SIZEOF_VOID_P-#define ALIGNMENT_HSFUNPTR ALIGNOF_VOID_P--#define SIZEOF_HSFOREIGNPTR SIZEOF_VOID_P-#define ALIGNMENT_HSFOREIGNPTR ALIGNOF_VOID_P--#define SIZEOF_HSSTABLEPTR SIZEOF_VOID_P-#define ALIGNMENT_HSSTABLEPTR ALIGNOF_VOID_P--#define SIZEOF_INT8 8-#define ALIGNMENT_INT8 ALIGNOF_UINT8_T--#define SIZEOF_WORD8 8-#define ALIGNMENT_WORD8 ALIGNOF_UINT8_T--#define SIZEOF_INT16 16-#define ALIGNMENT_INT16 ALIGNOF_UINT16_T--#define SIZEOF_WORD16 16-#define ALIGNMENT_WORD16 ALIGNOF_UINT16_T--#define SIZEOF_INT32 32-#define ALIGNMENT_INT32 ALIGNOF_UINT32_T--#define SIZEOF_WORD32 32-#define ALIGNMENT_WORD32 ALIGNOF_UINT32_T--#define SIZEOF_INT64 64-#define ALIGNMENT_INT64 ALIGNOF_UINT64_T--#define SIZEOF_WORD64 64-#define ALIGNMENT_WORD64 ALIGNOF_UINT64_T---#endif
@@ -1,147 +0,0 @@-{- ---------------------------------------------------------------------------// Macros to help make various instances for tuples.-// A kind of poor mans deriving.-//-// ----------------------------------------------------------------------------}--#define COMMA ,--{- ---------------------------------------------------------------------------// 2 tuple, 1 unary op-// ----------------------------------------------------------------------------}-#define TUPLE2_UNOP1_INSTANCE(clscon,op1,op1preArg,op1postArg,op1subop,pre,sep,post) \-instance (clscon a, clscon b) => clscon (a,b) where \- { op1 op1preArg (a,b) op1postArg \- = pre \- op1subop a \- sep op1subop b \- post \- }--{- ---------------------------------------------------------------------------// 3 tuple, 1 unary op-// ----------------------------------------------------------------------------}-#define TUPLE3_UNOP1_INSTANCE(clscon,op1,op1preArg,op1postArg,op1subop,pre,sep,post) \-instance (clscon a, clscon b, clscon c) => clscon (a,b,c) where \- { op1 op1preArg (a,b,c) op1postArg \- = pre \- op1subop a \- sep op1subop b \- sep op1subop c \- post \- }--{- ---------------------------------------------------------------------------// 4 tuple, 1 unary op-// ----------------------------------------------------------------------------}-#define TUPLE4_UNOP1_INSTANCE(clscon,op1,op1preArg,op1postArg,op1subop,pre,sep,post) \-instance (clscon a, clscon b, clscon c, clscon d) => clscon (a,b,c,d) where \- { op1 op1preArg (a,b,c,d) op1postArg \- = pre \- op1subop a \- sep op1subop b \- sep op1subop c \- sep op1subop d \- post \- }--{- ---------------------------------------------------------------------------// 5 tuple, 1 unary op-// ----------------------------------------------------------------------------}-#define TUPLE5_UNOP1_INSTANCE(clscon,op1,op1preArg,op1postArg,op1subop,pre,sep,post) \-instance (clscon a, clscon b, clscon c, clscon d, clscon e) => clscon (a,b,c,d,e) where \- { op1 op1preArg (a,b,c,d,e) op1postArg \- = pre \- op1subop a \- sep op1subop b \- sep op1subop c \- sep op1subop d \- sep op1subop e \- post \- }--{- ---------------------------------------------------------------------------// Set of 2..n tuple, 1 unary op-// ----------------------------------------------------------------------------}-#define TUPLE_UNOP1_INSTANCES(clscon,op1,op1preArg,op1postArg,op1subop,pre,sep,post) \-{ TUPLE2_UNOP1_INSTANCE(clscon,op1,op1preArg,op1postArg,op1subop,pre,sep,post) ;\- TUPLE3_UNOP1_INSTANCE(clscon,op1,op1preArg,op1postArg,op1subop,pre,sep,post) ;\- TUPLE4_UNOP1_INSTANCE(clscon,op1,op1preArg,op1postArg,op1subop,pre,sep,post) ;\- TUPLE5_UNOP1_INSTANCE(clscon,op1,op1preArg,op1postArg,op1subop,pre,sep,post) \-}--{- ---------------------------------------------------------------------------// 2 tuple, 1 binary op-// ----------------------------------------------------------------------------}-#define TUPLE2_BINOP1_INSTANCE(clscon,op1,op1subop,pre,sep,post) \-instance (clscon a, clscon b) => clscon (a,b) where \- { (a1,b1) op1 (a2,b2) \- = pre \- a1 op1subop a2 \- sep b1 op1subop b2 \- post \- }--{- ---------------------------------------------------------------------------// 3 tuple, 1 binary op-// ----------------------------------------------------------------------------}-#define TUPLE3_BINOP1_INSTANCE(clscon,op1,op1subop,pre,sep,post) \-instance (clscon a, clscon b, clscon c) => clscon (a,b,c) where \- { (a1,b1,c1) op1 (a2,b2,c2) \- = pre \- a1 op1subop a2 \- sep b1 op1subop b2 \- sep c1 op1subop c2 \- post \- }--{- ---------------------------------------------------------------------------// 4 tuple, 1 binary op-// ----------------------------------------------------------------------------}-#define TUPLE4_BINOP1_INSTANCE(clscon,op1,op1subop,pre,sep,post) \-instance (clscon a, clscon b, clscon c, clscon d) => clscon (a,b,c,d) where \- { (a1,b1,c1,d1) op1 (a2,b2,c2,d2) \- = pre \- a1 op1subop a2 \- sep b1 op1subop b2 \- sep c1 op1subop c2 \- sep d1 op1subop d2 \- post \- }--{- ---------------------------------------------------------------------------// 5 tuple, 1 binary op-// ----------------------------------------------------------------------------}-#define TUPLE5_BINOP1_INSTANCE(clscon,op1,op1subop,pre,sep,post) \-instance (clscon a, clscon b, clscon c, clscon d, clscon e) => clscon (a,b,c,d,e) where \- { (a1,b1,c1,d1,e1) op1 (a2,b2,c2,d2,e2) \- = pre \- a1 op1subop a2 \- sep b1 op1subop b2 \- sep c1 op1subop c2 \- sep d1 op1subop d2 \- sep e1 op1subop e2 \- post \- }--{- ---------------------------------------------------------------------------// Set of 2..n tuple, 1 binary op-// ----------------------------------------------------------------------------}-#define TUPLE_BINOP1_INSTANCES(clscon,op1,op1subop,pre,sep,post) \-{ TUPLE2_BINOP1_INSTANCE(clscon,op1,op1subop,pre,sep,post) ;\- TUPLE3_BINOP1_INSTANCE(clscon,op1,op1subop,pre,sep,post) ;\- TUPLE4_BINOP1_INSTANCE(clscon,op1,op1subop,pre,sep,post) ;\- TUPLE5_BINOP1_INSTANCE(clscon,op1,op1subop,pre,sep,post) \-}-
@@ -1,149 +0,0 @@-{- ---------------------------------------------------------------------------// Macros to help make Typeable instances.-//-// INSTANCE_TYPEABLEn(tc,tcname,"tc") defines-//-// instance Typeable/n/ tc-// instance Typeable a => Typeable/n-1/ (tc a)-// instance (Typeable a, Typeable b) => Typeable/n-2/ (tc a b)-// ...-// instance (Typeable a1, ..., Typeable an) => Typeable (tc a1 ... an)-// ----------------------------------------------------------------------------}--#ifndef TYPEABLE_H-#define TYPEABLE_H--#define INSTANCE_TYPEABLE0(tycon,tcname,str) \-tcname :: TyCon; \-tcname = mkTyCon str; \-instance Typeable tycon where { typeOf _ = mkTyConApp tcname [] }--#ifdef __GLASGOW_HASKELL__---- // For GHC, the extra instances follow from general instance declarations--- // defined in Data.Typeable.--#define INSTANCE_TYPEABLE1(tycon,tcname,str) \-tcname :: TyCon; \-tcname = mkTyCon str; \-instance Typeable1 tycon where { typeOf1 _ = mkTyConApp tcname [] }--#define INSTANCE_TYPEABLE2(tycon,tcname,str) \-tcname :: TyCon; \-tcname = mkTyCon str; \-instance Typeable2 tycon where { typeOf2 _ = mkTyConApp tcname [] }--#define INSTANCE_TYPEABLE3(tycon,tcname,str) \-tcname :: TyCon; \-tcname = mkTyCon str; \-instance Typeable3 tycon where { typeOf3 _ = mkTyConApp tcname [] }--#define INSTANCE_TYPEABLE4(tycon,tcname,str) \-tcname :: TyCon; \-tcname = mkTyCon str; \-instance Typeable4 tycon where { typeOf4 _ = mkTyConApp tcname [] }--#define INSTANCE_TYPEABLE5(tycon,tcname,str) \-tcname :: TyCon; \-tcname = mkTyCon str; \-instance Typeable5 tycon where { typeOf5 _ = mkTyConApp tcname [] }--#define INSTANCE_TYPEABLE6(tycon,tcname,str) \-tcname :: TyCon; \-tcname = mkTyCon str; \-instance Typeable6 tycon where { typeOf6 _ = mkTyConApp tcname [] }--#define INSTANCE_TYPEABLE7(tycon,tcname,str) \-tcname :: TyCon; \-tcname = mkTyCon str; \-instance Typeable7 tycon where { typeOf7 _ = mkTyConApp tcname [] }--#else /* !__GLASGOW_HASKELL__ */--#define INSTANCE_TYPEABLE1(tycon,tcname,str) \-tcname = mkTyCon str; \-instance Typeable1 tycon where { typeOf1 _ = mkTyConApp tcname [] }; \-instance Typeable a => Typeable (tycon a) where { typeOf = typeOfDefault }--#define INSTANCE_TYPEABLE2(tycon,tcname,str) \-tcname = mkTyCon str; \-instance Typeable2 tycon where { typeOf2 _ = mkTyConApp tcname [] }; \-instance Typeable a => Typeable1 (tycon a) where { \- typeOf1 = typeOf1Default }; \-instance (Typeable a, Typeable b) => Typeable (tycon a b) where { \- typeOf = typeOfDefault }--#define INSTANCE_TYPEABLE3(tycon,tcname,str) \-tcname = mkTyCon str; \-instance Typeable3 tycon where { typeOf3 _ = mkTyConApp tcname [] }; \-instance Typeable a => Typeable2 (tycon a) where { \- typeOf2 = typeOf2Default }; \-instance (Typeable a, Typeable b) => Typeable1 (tycon a b) where { \- typeOf1 = typeOf1Default }; \-instance (Typeable a, Typeable b, Typeable c) => Typeable (tycon a b c) where { \- typeOf = typeOfDefault }--#define INSTANCE_TYPEABLE4(tycon,tcname,str) \-tcname = mkTyCon str; \-instance Typeable4 tycon where { typeOf4 _ = mkTyConApp tcname [] }; \-instance Typeable a => Typeable3 (tycon a) where { \- typeOf3 = typeOf3Default }; \-instance (Typeable a, Typeable b) => Typeable2 (tycon a b) where { \- typeOf2 = typeOf2Default }; \-instance (Typeable a, Typeable b, Typeable c) => Typeable1 (tycon a b c) where { \- typeOf1 = typeOf1Default }; \-instance (Typeable a, Typeable b, Typeable c, Typeable d) => Typeable (tycon a b c d) where { \- typeOf = typeOfDefault }--#define INSTANCE_TYPEABLE5(tycon,tcname,str) \-tcname = mkTyCon str; \-instance Typeable5 tycon where { typeOf5 _ = mkTyConApp tcname [] }; \-instance Typeable a => Typeable4 (tycon a) where { \- typeOf4 = typeOf4Default }; \-instance (Typeable a, Typeable b) => Typeable3 (tycon a b) where { \- typeOf3 = typeOf3Default }; \-instance (Typeable a, Typeable b, Typeable c) => Typeable2 (tycon a b c) where { \- typeOf2 = typeOf2Default }; \-instance (Typeable a, Typeable b, Typeable c, Typeable d) => Typeable1 (tycon a b c d) where { \- typeOf1 = typeOf1Default }; \-instance (Typeable a, Typeable b, Typeable c, Typeable d, Typeable e) => Typeable (tycon a b c d e) where { \- typeOf = typeOfDefault }--#define INSTANCE_TYPEABLE6(tycon,tcname,str) \-tcname = mkTyCon str; \-instance Typeable6 tycon where { typeOf6 _ = mkTyConApp tcname [] }; \-instance Typeable a => Typeable5 (tycon a) where { \- typeOf5 = typeOf5Default }; \-instance (Typeable a, Typeable b) => Typeable4 (tycon a b) where { \- typeOf4 = typeOf4Default }; \-instance (Typeable a, Typeable b, Typeable c) => Typeable3 (tycon a b c) where { \- typeOf3 = typeOf3Default }; \-instance (Typeable a, Typeable b, Typeable c, Typeable d) => Typeable2 (tycon a b c d) where { \- typeOf2 = typeOf2Default }; \-instance (Typeable a, Typeable b, Typeable c, Typeable d, Typeable e) => Typeable1 (tycon a b c d e) where { \- typeOf1 = typeOf1Default }; \-instance (Typeable a, Typeable b, Typeable c, Typeable d, Typeable e, Typeable f) => Typeable (tycon a b c d e f) where { \- typeOf = typeOfDefault }--#define INSTANCE_TYPEABLE7(tycon,tcname,str) \-tcname = mkTyCon str; \-instance Typeable7 tycon where { typeOf7 _ = mkTyConApp tcname [] }; \-instance Typeable a => Typeable6 (tycon a) where { \- typeOf6 = typeOf6Default }; \-instance (Typeable a, Typeable b) => Typeable5 (tycon a b) where { \- typeOf5 = typeOf5Default }; \-instance (Typeable a, Typeable b, Typeable c) => Typeable4 (tycon a b c) where { \- typeOf4 = typeOf4Default }; \-instance (Typeable a, Typeable b, Typeable c, Typeable d) => Typeable3 (tycon a b c d) where { \- typeOf3 = typeOf3Default }; \-instance (Typeable a, Typeable b, Typeable c, Typeable d, Typeable e) => Typeable2 (tycon a b c d e) where { \- typeOf2 = typeOf2Default }; \-instance (Typeable a, Typeable b, Typeable c, Typeable d, Typeable e, Typeable f) => Typeable1 (tycon a b c d e f) where { \- typeOf1 = typeOf1Default }; \-instance (Typeable a, Typeable b, Typeable c, Typeable d, Typeable e, Typeable f, Typeable g) => Typeable (tycon a b c d e f g) where { \- typeOf = typeOfDefault }--#endif /* !__GLASGOW_HASKELL__ */--#endif
@@ -1,11 +0,0 @@-/* - * (c) The University of Glasgow 2002- *- * Directory Runtime Support- */-#ifndef __DIRUTILS_H__-#define __DIRUTILS_H__--extern int __hscore_readdir(DIR *dirPtr, struct dirent **pDirEnt);--#endif /* __DIRUTILS_H__ */
@@ -1,2 +0,0 @@-exposed-modules: Control.Monad Data.Bits Data.Char Data.Either Data.Int Data.IORef Data.List Data.Maybe Data.Typeable Data.Word Debug.Trace Foreign.C.Error Foreign.C.String Foreign.C.Types Foreign.C Foreign.ForeignPtr Foreign.Marshal.Alloc Foreign.Marshal.Array Foreign.Marshal.Error Foreign.Marshal.Pool Foreign.Marshal.Utils Foreign.Marshal Foreign.Ptr Foreign.StablePtr Foreign.Storable Foreign System.IO.Error System.IO.Fix System.IO.Unsafe System.IO System.Posix.Internals System.Posix.Types UHC.Array UHC.Base UHC.Bits UHC.Bounded UHC.BoxArray UHC.ByteArray UHC.Char UHC.Conc UHC.Enum UHC.Eq UHC.Float UHC.ForeignPtr UHC.GC UHC.Generics.Tuple UHC.Generics UHC.Handle UHC.Int UHC.IO UHC.IOBase UHC.Ix UHC.LazyST UHC.MutVar UHC.MVar UHC.OldException UHC.OldIO UHC.Ord UHC.Prims UHC.Ptr UHC.Read UHC.Real UHC.Run UHC.Show UHC.ST UHC.StablePtr UHC.StackTrace UHC.Storable UHC.STRef UHC.Types UHC.Weak UHC.WeakPtr UHC.Word Unsafe.Coerce-build-depends:
binary file changed (absent → 61204 bytes)
binary file changed (absent → 65011 bytes)
binary file changed (absent → 23602 bytes)
binary file changed (absent → 82640 bytes)
binary file changed (absent → 92939 bytes)
binary file changed (absent → 20758 bytes)
binary file changed (absent → 11493 bytes)
binary file changed (absent → 16286 bytes)
binary file changed (absent → 5480 bytes)
binary file changed (absent → 6580 bytes)
binary file changed (absent → 7090 bytes)
binary file changed (absent → 3404 bytes)
binary file changed (absent → 3460 bytes)
binary file changed (absent → 3414 bytes)
binary file changed (absent → 3169 bytes)
binary file changed (absent → 204309 bytes)
binary file changed (absent → 253604 bytes)
binary file changed (absent → 33649 bytes)
binary file changed (absent → 8206 bytes)
binary file changed (absent → 9526 bytes)
binary file changed (absent → 4237 bytes)
binary file changed (absent → 175368 bytes)
binary file changed (absent → 233475 bytes)
binary file changed (absent → 84325 bytes)
binary file changed (absent → 3180 bytes)
binary file changed (absent → 3122 bytes)
binary file changed (absent → 4424 bytes)
binary file changed (absent → 405 bytes)
binary file changed (absent → 407 bytes)
binary file changed (absent → 3277 bytes)
binary file changed (absent → 149 bytes)
binary file changed (absent → 161 bytes)
binary file changed (absent → 2261 bytes)
binary file changed (absent → 22836 bytes)
binary file changed (absent → 29138 bytes)
binary file changed (absent → 16561 bytes)
binary file changed (absent → 30548 bytes)
binary file changed (absent → 40457 bytes)
binary file changed (absent → 15702 bytes)
binary file changed (absent → 4750 bytes)
binary file changed (absent → 6016 bytes)
binary file changed (absent → 1947 bytes)
binary file changed (absent → 1004 bytes)
binary file changed (absent → 1011 bytes)
binary file changed (absent → 1967 bytes)
binary file changed (absent → 216779 bytes)
binary file changed (absent → 264771 bytes)
binary file changed (absent → 48725 bytes)
file too large to diff
file too large to diff
binary file changed (absent → 671363 bytes)
binary file changed (absent → 13522 bytes)
binary file changed (absent → 13321 bytes)
binary file changed (absent → 5033 bytes)
binary file changed (absent → 122012 bytes)
binary file changed (absent → 210879 bytes)
binary file changed (absent → 54524 bytes)
binary file changed (absent → 29641 bytes)
binary file changed (absent → 37085 bytes)
binary file changed (absent → 15248 bytes)
binary file changed (absent → 5241 bytes)
binary file changed (absent → 7254 bytes)
binary file changed (absent → 1271 bytes)
binary file changed (absent → 8372 bytes)
binary file changed (absent → 8780 bytes)
binary file changed (absent → 2947 bytes)
binary file changed (absent → 107242 bytes)
binary file changed (absent → 189772 bytes)
binary file changed (absent → 60483 bytes)
binary file changed (absent → 58825 bytes)
binary file changed (absent → 81431 bytes)
binary file changed (absent → 1793 bytes)
binary file changed (absent → 688 bytes)
binary file changed (absent → 664 bytes)
binary file changed (absent → 1242 bytes)
binary file changed (absent → 207 bytes)
binary file changed (absent → 217 bytes)
binary file changed (absent → 16436 bytes)
binary file changed (absent → 670235 bytes)
binary file changed (absent → 810519 bytes)
binary file changed (absent → 304588 bytes)
binary file changed (absent → 132474 bytes)
binary file changed (absent → 164105 bytes)
binary file changed (absent → 31259 bytes)
binary file changed (absent → 15533 bytes)
binary file changed (absent → 15711 bytes)
binary file changed (absent → 5768 bytes)
binary file changed (absent → 340989 bytes)
binary file changed (absent → 465854 bytes)
binary file changed (absent → 96849 bytes)
binary file changed (absent → 76885 bytes)
binary file changed (absent → 104581 bytes)
binary file changed (absent → 21425 bytes)
binary file changed (absent → 37718 bytes)
binary file changed (absent → 46432 bytes)
binary file changed (absent → 16704 bytes)
binary file changed (absent → 29152 bytes)
binary file changed (absent → 36861 bytes)
binary file changed (absent → 8322 bytes)
binary file changed (absent → 18353 bytes)
binary file changed (absent → 21242 bytes)
binary file changed (absent → 7529 bytes)
binary file changed (absent → 12357 bytes)
binary file changed (absent → 14957 bytes)
binary file changed (absent → 4479 bytes)
binary file changed (absent → 68995 bytes)
binary file changed (absent → 80694 bytes)
binary file changed (absent → 16233 bytes)
binary file changed (absent → 206208 bytes)
binary file changed (absent → 202478 bytes)
binary file changed (absent → 68189 bytes)
binary file changed (absent → 25281 bytes)
binary file changed (absent → 34355 bytes)
binary file changed (absent → 14986 bytes)
binary file changed (absent → 87664 bytes)
binary file changed (absent → 103119 bytes)
binary file changed (absent → 11157 bytes)
binary file changed (absent → 7211 bytes)
binary file changed (absent → 8404 bytes)
binary file changed (absent → 1487 bytes)
binary file changed (absent → 11814 bytes)
binary file changed (absent → 12733 bytes)
binary file changed (absent → 4168 bytes)
binary file changed (absent → 47946 bytes)
binary file changed (absent → 62221 bytes)
binary file changed (absent → 22525 bytes)
binary file changed (absent → 22999 bytes)
binary file changed (absent → 29097 bytes)
binary file changed (absent → 11190 bytes)
binary file changed (absent → 152800 bytes)
binary file changed (absent → 200344 bytes)
binary file changed (absent → 23521 bytes)
binary file changed (absent → 21991 bytes)
binary file changed (absent → 27646 bytes)
binary file changed (absent → 11678 bytes)
binary file changed (absent → 141 bytes)
binary file changed (absent → 153 bytes)
binary file changed (absent → 1382 bytes)
binary file changed (absent → 69186 bytes)
binary file changed (absent → 96016 bytes)
binary file changed (absent → 31505 bytes)
binary file changed (absent → 27276 bytes)
binary file changed (absent → 33790 bytes)
binary file changed (absent → 13368 bytes)
binary file changed (absent → 13934 bytes)
binary file changed (absent → 15797 bytes)
binary file changed (absent → 7225 bytes)
binary file changed (absent → 140 bytes)
binary file changed (absent → 152 bytes)
binary file changed (absent → 855 bytes)
@@ -0,0 +1,231 @@+{- --------------------------------------------------------------------------+// Dirty CPP hackery for CTypes/CTypesISO+//+// (c) The FFI task force, 2000+// --------------------------------------------------------------------------+-}++#ifndef CTYPES__H+#define CTYPES__H++#include "Typeable.h"++{-+// As long as there is no automatic derivation of classes for newtypes we resort+// to extremely dirty cpp-hackery. :-P Some care has to be taken when the+// macros below are modified, otherwise the layout rule will bite you.+-}++-- // A hacked version for GHC follows the Haskell 98 version...+#ifndef __GLASGOW_HASKELL__++#define NEWTYPE_TYPE_NODERIVING(T,B) \+newtype T = T B ; ++#define NEWTYPE_TYPE(T,B) \+newtype T = T B deriving (Eq, Ord) ; ++#define ARITHMETIC_TYPE_INSTANCES(T,C,S,B) \+INSTANCE_NUM(T) ; \+INSTANCE_REAL(T) ; \+INSTANCE_READ(T,B) ; \+INSTANCE_SHOW(T,B) ; \+INSTANCE_ENUM(T) ; \+INSTANCE_STORABLE(T) ; \+INSTANCE_TYPEABLE0(T,C,S) ;++#define INTEGRAL_TYPE_INSTANCES(T,C,S,B) \+INSTANCE_BOUNDED(T) ; \+INSTANCE_INTEGRAL(T) ; \+INSTANCE_BITS(T)++#define ARITHMETIC_TYPE(T,C,S,B) \+NEWTYPE_TYPE(T,B) ; \+ARITHMETIC_TYPE_INSTANCES(T,C,S,B) ;++#define INTEGRAL_TYPE(T,C,S,B) \+ARITHMETIC_TYPE(T,C,S,B) ; \+INTEGRAL_TYPE_INSTANCES(T,C,S,B)++#define FLOATING_TYPE(T,C,S,B) \+ARITHMETIC_TYPE(T,C,S,B) ; \+INSTANCE_FRACTIONAL(T) ; \+INSTANCE_FLOATING(T) ; \+INSTANCE_REALFRAC(T) ; \+INSTANCE_REALFLOAT(T)++#ifndef __GLASGOW_HASKELL__+#define fakeMap map+#endif++#define INSTANCE_READ(T,B) \+instance Read T where { \+ readsPrec p s = fakeMap (\(x, t) -> (T x, t)) (readsPrec p s) }++#define INSTANCE_SHOW(T,B) \+instance Show T where { \+ showsPrec p (T x) = showsPrec p x }++#define INSTANCE_NUM(T) \+instance Num T where { \+ (T i) + (T j) = T (i + j) ; \+ (T i) - (T j) = T (i - j) ; \+ (T i) * (T j) = T (i * j) ; \+ negate (T i) = T (negate i) ; \+ abs (T i) = T (abs i) ; \+ signum (T i) = T (signum i) ; \+ fromInteger x = T (fromInteger x) }++#define INSTANCE_EQ(T) \+instance Eq T where { \+ (T x1) == (T x2) = x1 == x2 }++#define INSTANCE_ORD(T) \+instance Ord T where { \+ (T x1) `compare` (T x2) = x1 `compare` x2 }++#define INSTANCE_BOUNDED(T) \+instance Bounded T where { \+ minBound = T minBound ; \+ maxBound = T maxBound }++#define INSTANCE_ENUM(T) \+instance Enum T where { \+ succ (T i) = T (succ i) ; \+ pred (T i) = T (pred i) ; \+ toEnum x = T (toEnum x) ; \+ fromEnum (T i) = fromEnum i ; \+ enumFrom (T i) = fakeMap T (enumFrom i) ; \+ enumFromThen (T i) (T j) = fakeMap T (enumFromThen i j) ; \+ enumFromTo (T i) (T j) = fakeMap T (enumFromTo i j) ; \+ enumFromThenTo (T i) (T j) (T k) = fakeMap T (enumFromThenTo i j k) }++#define INSTANCE_REAL(T) \+instance Real T where { \+ toRational (T i) = toRational i }++#define INSTANCE_INTEGRAL(T) \+instance Integral T where { \+ (T i) `quot` (T j) = T (i `quot` j) ; \+ (T i) `rem` (T j) = T (i `rem` j) ; \+ (T i) `div` (T j) = T (i `div` j) ; \+ (T i) `mod` (T j) = T (i `mod` j) ; \+ (T i) `quotRem` (T j) = let (q,r) = i `quotRem` j in (T q, T r) ; \+ (T i) `divMod` (T j) = let (d,m) = i `divMod` j in (T d, T m) ; \+ toInteger (T i) = toInteger i }++#define INSTANCE_BITS(T) \+instance Bits T where { \+ (T x) .&. (T y) = T (x .&. y) ; \+ (T x) .|. (T y) = T (x .|. y) ; \+ (T x) `xor` (T y) = T (x `xor` y) ; \+ complement (T x) = T (complement x) ; \+ shift (T x) n = T (shift x n) ; \+ rotate (T x) n = T (rotate x n) ; \+ bit n = T (bit n) ; \+ setBit (T x) n = T (setBit x n) ; \+ clearBit (T x) n = T (clearBit x n) ; \+ complementBit (T x) n = T (complementBit x n) ; \+ testBit (T x) n = testBit x n ; \+ bitSize (T x) = bitSize x ; \+ isSigned (T x) = isSigned x }++#define INSTANCE_FRACTIONAL(T) \+instance Fractional T where { \+ (T x) / (T y) = T (x / y) ; \+ recip (T x) = T (recip x) ; \+ fromRational r = T (fromRational r) }++#define INSTANCE_FLOATING(T) \+instance Floating T where { \+ pi = pi ; \+ exp (T x) = T (exp x) ; \+ log (T x) = T (log x) ; \+ sqrt (T x) = T (sqrt x) ; \+ (T x) ** (T y) = T (x ** y) ; \+ (T x) `logBase` (T y) = T (x `logBase` y) ; \+ sin (T x) = T (sin x) ; \+ cos (T x) = T (cos x) ; \+ tan (T x) = T (tan x) ; \+ asin (T x) = T (asin x) ; \+ acos (T x) = T (acos x) ; \+ atan (T x) = T (atan x) ; \+ sinh (T x) = T (sinh x) ; \+ cosh (T x) = T (cosh x) ; \+ tanh (T x) = T (tanh x) ; \+ asinh (T x) = T (asinh x) ; \+ acosh (T x) = T (acosh x) ; \+ atanh (T x) = T (atanh x) }++#define INSTANCE_REALFRAC(T) \+instance RealFrac T where { \+ properFraction (T x) = let (m,y) = properFraction x in (m, T y) ; \+ truncate (T x) = truncate x ; \+ round (T x) = round x ; \+ ceiling (T x) = ceiling x ; \+ floor (T x) = floor x }++#define INSTANCE_REALFLOAT(T) \+instance RealFloat T where { \+ floatRadix (T x) = floatRadix x ; \+ floatDigits (T x) = floatDigits x ; \+ floatRange (T x) = floatRange x ; \+ decodeFloat (T x) = decodeFloat x ; \+ encodeFloat m n = T (encodeFloat m n) ; \+ exponent (T x) = exponent x ; \+ significand (T x) = T (significand x) ; \+ scaleFloat n (T x) = T (scaleFloat n x) ; \+ isNaN (T x) = isNaN x ; \+ isInfinite (T x) = isInfinite x ; \+ isDenormalized (T x) = isDenormalized x ; \+ isNegativeZero (T x) = isNegativeZero x ; \+ isIEEE (T x) = isIEEE x ; \+ (T x) `atan2` (T y) = T (x `atan2` y) }++#define INSTANCE_STORABLE(T) \+instance Storable T where { \+ sizeOf (T x) = sizeOf x ; \+ alignment (T x) = alignment x ; \+ peekElemOff a i = liftM T (peekElemOff (castPtr a) i) ; \+ pokeElemOff a i (T x) = pokeElemOff (castPtr a) i x }++#else /* __GLASGOW_HASKELL__ */++-- // GHC can derive any class for a newtype, so we make use of that here...++#define ARITHMETIC_CLASSES Eq,Ord,Num,Enum,Storable,Real+#define INTEGRAL_CLASSES Bounded,Integral,Bits+#define FLOATING_CLASSES Fractional,Floating,RealFrac,RealFloat++#define ARITHMETIC_TYPE(T,C,S,B) \+newtype T = T B deriving (ARITHMETIC_CLASSES); \+INSTANCE_READ(T,B); \+INSTANCE_SHOW(T,B); \+INSTANCE_TYPEABLE0(T,C,S) ;++#define INTEGRAL_TYPE(T,C,S,B) \+newtype T = T B deriving (ARITHMETIC_CLASSES, INTEGRAL_CLASSES); \+INSTANCE_READ(T,B); \+INSTANCE_SHOW(T,B); \+INSTANCE_TYPEABLE0(T,C,S) ;++#define FLOATING_TYPE(T,C,S,B) \+newtype T = T B deriving (ARITHMETIC_CLASSES, FLOATING_CLASSES); \+INSTANCE_READ(T,B); \+INSTANCE_SHOW(T,B); \+INSTANCE_TYPEABLE0(T,C,S) ;++#define INSTANCE_READ(T,B) \+instance Read T where { \+ readsPrec = unsafeCoerce# (readsPrec :: Int -> ReadS B); \+ readList = unsafeCoerce# (readList :: ReadS [B]); }++#define INSTANCE_SHOW(T,B) \+instance Show T where { \+ showsPrec = unsafeCoerce# (showsPrec :: Int -> B -> ShowS); \+ show = unsafeCoerce# (show :: B -> String); \+ showList = unsafeCoerce# (showList :: [B] -> ShowS); }++#endif /* __GLASGOW_HASKELL__ */++#endif
@@ -0,0 +1,757 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The University of Glasgow 2001-2004+ *+ * Definitions for package `base' which are visible in Haskell land.+ *+ * Adapted for use in EHC+ *+ * ---------------------------------------------------------------------------*/++#ifndef __HSBASE_H__+#define __HSBASE_H__++#include "HsBaseConfig.h"+#ifdef __UHC_BUILDS_O__+#include "rts.h"+#endif++/* ultra-evil... */+#undef PACKAGE_BUGREPORT+#undef PACKAGE_NAME+#undef PACKAGE_STRING+#undef PACKAGE_TARNAME+#undef PACKAGE_VERSION++/* Needed to get the macro version of errno on some OSs (eg. Solaris).+ We must do this, because these libs are only compiled once, but+ must work in both single-threaded and multi-threaded programs. */+#define _REENTRANT 1++#ifndef __UHC__+#include "HsFFI.h"+#endif /* !__UHC__ */++#include <stdio.h>+#include <stdlib.h>+#include <math.h>++#if HAVE_SYS_TYPES_H+#include <sys/types.h>+#endif+#if HAVE_UNISTD_H+#include <unistd.h>+#endif+#if HAVE_SYS_STAT_H+#include <sys/stat.h>+#endif+#if HAVE_FCNTL_H+# include <fcntl.h>+#endif+#if HAVE_TERMIOS_H+#include <termios.h>+#endif+#if HAVE_SIGNAL_H+#include <signal.h>+/* Ultra-ugly: OpenBSD uses broken macros for sigemptyset and sigfillset (missing casts) */+#if __OpenBSD__+#undef sigemptyset+#undef sigfillset+#endif+#endif+#if HAVE_ERRNO_H+#include <errno.h>+#endif+#if HAVE_STRING_H+#include <string.h>+#endif+#if HAVE_DIRENT_H+#include <dirent.h>+#endif+#if HAVE_UTIME_H+#include <utime.h>+#endif+#if HAVE_SYS_UTSNAME_H+#include <sys/utsname.h>+#endif+#if HAVE_GETTIMEOFDAY+# if HAVE_SYS_TIME_H+# include <sys/time.h>+# endif+#elif HAVE_GETCLOCK+# if HAVE_SYS_TIMERS_H+# define POSIX_4D9 1+# include <sys/timers.h>+# endif+#endif+#if HAVE_TIME_H+#include <time.h>+#endif+#if HAVE_SYS_TIMEB_H+#include <sys/timeb.h>+#endif+#if HAVE_WINDOWS_H+#include <windows.h>+#endif+#if HAVE_SYS_TIMES_H+#include <sys/times.h>+#endif+#if HAVE_WINSOCK_H && defined(__MINGW32__)+#include <winsock.h>+#endif+#if HAVE_LIMITS_H+#include <limits.h>+#endif+#if HAVE_WCTYPE_H+#include <wctype.h>+#endif+#if HAVE_INTTYPES_H+# include <inttypes.h>+#elif HAVE_STDINT_H+# include <stdint.h>+#endif++#if !defined(__MINGW32__) && !defined(irix_HOST_OS)+# if HAVE_SYS_RESOURCE_H+# include <sys/resource.h>+# endif+#endif++#if !HAVE_GETRUSAGE && HAVE_SYS_SYSCALL_H+# include <sys/syscall.h>+# if defined(SYS_GETRUSAGE) /* hpux_HOST_OS */+# define getrusage(a, b) syscall(SYS_GETRUSAGE, a, b)+# define HAVE_GETRUSAGE 1+# endif+#endif++/* For System */+#if HAVE_SYS_WAIT_H+#include <sys/wait.h>+#endif+#if HAVE_VFORK_H+#include <vfork.h>+#endif++#ifndef __UHC__+#include "dirUtils.h"+#endif+#ifndef __UHC__+#include "WCsubst.h"+#endif /* !__UHC__ */++#if defined(__MINGW32__)+/* in Win32Utils.c */+extern void maperrno (void);+extern HsWord64 getUSecOfDay(void);+#endif++#if defined(__MINGW32__)+#include <io.h>+#include <fcntl.h>+#include <shlobj.h>+#include <share.h>+#endif++#if HAVE_SYS_SELECT_H+#include <sys/select.h>+#endif++/* in inputReady.c */+extern int fdReady(int fd, int write, int msecs, int isSock);++#ifndef __UHC__+/* in Signals.c */+extern HsInt nocldstop;+#endif /* !__UHC__ */++#ifndef __UHC__+/* -----------------------------------------------------------------------------+ 64-bit operations, defined in longlong.c+ -------------------------------------------------------------------------- */++#ifdef SUPPORT_LONG_LONGS++HsBool hs_gtWord64 (HsWord64, HsWord64);+HsBool hs_geWord64 (HsWord64, HsWord64);+HsBool hs_eqWord64 (HsWord64, HsWord64);+HsBool hs_neWord64 (HsWord64, HsWord64);+HsBool hs_ltWord64 (HsWord64, HsWord64);+HsBool hs_leWord64 (HsWord64, HsWord64);++HsBool hs_gtInt64 (HsInt64, HsInt64);+HsBool hs_geInt64 (HsInt64, HsInt64);+HsBool hs_eqInt64 (HsInt64, HsInt64);+HsBool hs_neInt64 (HsInt64, HsInt64);+HsBool hs_ltInt64 (HsInt64, HsInt64);+HsBool hs_leInt64 (HsInt64, HsInt64);++HsWord64 hs_remWord64 (HsWord64, HsWord64);+HsWord64 hs_quotWord64 (HsWord64, HsWord64);++HsInt64 hs_remInt64 (HsInt64, HsInt64);+HsInt64 hs_quotInt64 (HsInt64, HsInt64);+HsInt64 hs_negateInt64 (HsInt64);+HsInt64 hs_plusInt64 (HsInt64, HsInt64);+HsInt64 hs_minusInt64 (HsInt64, HsInt64);+HsInt64 hs_timesInt64 (HsInt64, HsInt64);++HsWord64 hs_and64 (HsWord64, HsWord64);+HsWord64 hs_or64 (HsWord64, HsWord64);+HsWord64 hs_xor64 (HsWord64, HsWord64);+HsWord64 hs_not64 (HsWord64);++HsWord64 hs_uncheckedShiftL64 (HsWord64, HsInt);+HsWord64 hs_uncheckedShiftRL64 (HsWord64, HsInt);+HsInt64 hs_uncheckedIShiftL64 (HsInt64, HsInt);+HsInt64 hs_uncheckedIShiftRA64 (HsInt64, HsInt);+HsInt64 hs_uncheckedIShiftRL64 (HsInt64, HsInt);++HsInt64 hs_intToInt64 (HsInt);+HsInt hs_int64ToInt (HsInt64);+HsWord64 hs_int64ToWord64 (HsInt64);+HsWord64 hs_wordToWord64 (HsWord);+HsWord hs_word64ToWord (HsWord64);+HsInt64 hs_word64ToInt64 (HsWord64);++HsWord64 hs_integerToWord64 (HsInt sa, StgByteArray /* Really: mp_limb_t* */ da);+HsInt64 hs_integerToInt64 (HsInt sa, StgByteArray /* Really: mp_limb_t* */ da);++#endif /* SUPPORT_LONG_LONGS */+#endif /* !__UHC__ */++/* -----------------------------------------------------------------------------+ INLINE functions.++ These functions are given as inlines here for when compiling via C,+ but we also generate static versions into the cbits library for+ when compiling to native code.+ -------------------------------------------------------------------------- */++#ifndef INLINE+# if defined(_MSC_VER)+# define INLINE extern __inline+# else+# define INLINE static inline+# endif+#endif++INLINE int __hscore_get_errno(void) { return errno; }+INLINE void __hscore_set_errno(int e) { errno = e; }++#if !defined(_MSC_VER)+INLINE int __hscore_s_isreg(mode_t m) { return S_ISREG(m); }+INLINE int __hscore_s_isdir(mode_t m) { return S_ISDIR(m); }+INLINE int __hscore_s_isfifo(mode_t m) { return S_ISFIFO(m); }+INLINE int __hscore_s_isblk(mode_t m) { return S_ISBLK(m); }+INLINE int __hscore_s_ischr(mode_t m) { return S_ISCHR(m); }+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)+INLINE int __hscore_s_issock(mode_t m) { return S_ISSOCK(m); }+#endif+#endif++#if ( !defined(_MSC_VER) && !defined(__MINGW32__) && !defined(_WIN32) ) || defined(__CYGWIN__)+INLINE int+__hscore_sigemptyset( sigset_t *set )+{ return sigemptyset(set); }++INLINE int+__hscore_sigfillset( sigset_t *set )+{ return sigfillset(set); }++INLINE int+__hscore_sigaddset( sigset_t * set, int s )+{ return sigaddset(set,s); }++INLINE int+__hscore_sigdelset( sigset_t * set, int s )+{ return sigdelset(set,s); }++INLINE int+__hscore_sigismember( sigset_t * set, int s )+{ return sigismember(set,s); }+#endif++INLINE void *+__hscore_memcpy_dst_off( char *dst, int dst_off, char *src, size_t sz )+{ return memcpy(dst+dst_off, src, sz); }++INLINE void *+__hscore_memcpy_src_off( char *dst, char *src, int src_off, size_t sz )+{ return memcpy(dst, src+src_off, sz); }++INLINE HsBool+__hscore_supportsTextMode()+{+#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)+ return HS_BOOL_FALSE;+#else+ return HS_BOOL_TRUE;+#endif+}++INLINE HsInt+__hscore_bufsiz()+{+ return BUFSIZ;+}++INLINE int+__hscore_seek_cur()+{+ return SEEK_CUR;+}++INLINE int+__hscore_o_binary()+{+#if defined(_MSC_VER)+ return O_BINARY;+#else+ return CONST_O_BINARY;+#endif+}++INLINE int+__hscore_o_rdonly()+{+#ifdef O_RDONLY+ return O_RDONLY;+#else+ return 0;+#endif+}++INLINE int+__hscore_o_wronly( void )+{+#ifdef O_WRONLY+ return O_WRONLY;+#else+ return 0;+#endif+}++INLINE int+__hscore_o_rdwr( void )+{+#ifdef O_RDWR+ return O_RDWR;+#else+ return 0;+#endif+}++INLINE int+__hscore_o_append( void )+{+#ifdef O_APPEND+ return O_APPEND;+#else+ return 0;+#endif+}++INLINE int+__hscore_o_creat( void )+{+#ifdef O_CREAT+ return O_CREAT;+#else+ return 0;+#endif+}++INLINE int+__hscore_o_excl( void )+{+#ifdef O_EXCL+ return O_EXCL;+#else+ return 0;+#endif+}++INLINE int+__hscore_o_trunc( void )+{+#ifdef O_TRUNC+ return O_TRUNC;+#else+ return 0;+#endif+}++INLINE int+__hscore_o_noctty( void )+{+#ifdef O_NOCTTY+ return O_NOCTTY;+#else+ return 0;+#endif+}++INLINE int+__hscore_o_nonblock( void )+{+#ifdef O_NONBLOCK+ return O_NONBLOCK;+#else+ return 0;+#endif+}++INLINE int+__hscore_seek_set( void )+{+ return SEEK_SET;+}++INLINE int+__hscore_seek_end( void )+{+ return SEEK_END;+}++INLINE int+__hscore_ftruncate( int fd, off_t where )+{+#if defined(HAVE_FTRUNCATE)+ return ftruncate(fd,where);+#elif defined(HAVE__CHSIZE)+ return _chsize(fd,where);+#else+// ToDo: we should use _chsize_s() on Windows which allows a 64-bit+// offset, but it doesn't seem to be available from mingw at this time +// --SDM (01/2008)+#error at least ftruncate or _chsize functions are required to build+#endif+}++#ifndef __UHC__+INLINE int+__hscore_setmode( int fd, HsBool toBin )+{+#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)+ return setmode(fd,(toBin == HS_BOOL_TRUE) ? _O_BINARY : _O_TEXT);+#else+ return 0;+#endif+}+#endif /* !__UHC__ */++#if __GLASGOW_HASKELL__++INLINE int+__hscore_PrelHandle_write( int fd, void *ptr, HsInt off, int sz )+{+ return write(fd,(char *)ptr + off, sz);+}++INLINE int+__hscore_PrelHandle_read( int fd, void *ptr, HsInt off, int sz )+{+ return read(fd,(char *)ptr + off, sz);++}++#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)+INLINE int+__hscore_PrelHandle_send( int fd, void *ptr, HsInt off, int sz )+{+ return send(fd,(char *)ptr + off, sz, 0);+}++INLINE int+__hscore_PrelHandle_recv( int fd, void *ptr, HsInt off, int sz )+{+ return recv(fd,(char *)ptr + off, sz, 0);+}+#endif++#endif /* __GLASGOW_HASKELL__ */++INLINE int+__hscore_mkdir( char *pathName, int mode )+{+#if ( defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) ) && !defined(__CYGWIN__)+ return mkdir(pathName);+#else+ return mkdir(pathName,mode);+#endif+}++INLINE int+__hscore_lstat( const char *fname, struct stat *st )+{+#if HAVE_LSTAT+ return lstat(fname, st);+#else+ return stat(fname, st);+#endif+}++INLINE char *+__hscore_d_name( struct dirent* d )+{+ return (d->d_name);+}++INLINE int+__hscore_end_of_dir( void )+{+ return READDIR_ERRNO_EOF;+}++INLINE void+__hscore_free_dirent(struct dirent *dEnt)+{+#if HAVE_READDIR_R+ free(dEnt);+#endif+}++#if defined(__MINGW32__)+// We want the versions of stat/fstat/lseek that use 64-bit offsets,+// and you have to ask for those explicitly. Unfortunately there+// doesn't seem to be a 64-bit version of truncate/ftruncate, so while+// hFileSize and hSeek will work with large files, hSetFileSize will not.+#define stat(file,buf) _stati64(file,buf)+#define fstat(fd,buf) _fstati64(fd,buf)+typedef struct _stati64 struct_stat;+typedef off64_t stsize_t;+#else+typedef struct stat struct_stat;+typedef off_t stsize_t;+#endif++INLINE HsInt+__hscore_sizeof_stat( void )+{+ return sizeof(struct_stat);+}++INLINE time_t __hscore_st_mtime ( struct_stat* st ) { return st->st_mtime; }+INLINE stsize_t __hscore_st_size ( struct_stat* st ) { return st->st_size; }+#if !defined(_MSC_VER)+INLINE mode_t __hscore_st_mode ( struct_stat* st ) { return st->st_mode; }+INLINE dev_t __hscore_st_dev ( struct_stat* st ) { return st->st_dev; }+INLINE ino_t __hscore_st_ino ( struct_stat* st ) { return st->st_ino; }+#endif++#if HAVE_TERMIOS_H+INLINE tcflag_t __hscore_lflag( struct termios* ts ) { return ts->c_lflag; }++INLINE void+__hscore_poke_lflag( struct termios* ts, tcflag_t t ) { ts->c_lflag = t; }++INLINE unsigned char*+__hscore_ptr_c_cc( struct termios* ts )+{ return (unsigned char*) &ts->c_cc; }++INLINE HsInt+__hscore_sizeof_termios( void )+{+#ifndef __MINGW32__+ return sizeof(struct termios);+#else+ return 0;+#endif+}+#endif++//sizeof_sigset_t is also use on windows systems which define tcflat_t. Why exclude it?+// #if !defined(_MSC_VER) && !defined(__MINGW32__) && !defined(_WIN32)+INLINE HsInt+__hscore_sizeof_sigset_t( void )+{+ return sizeof(sigset_t);+}+// #endif++INLINE int+__hscore_echo( void )+{+#ifdef ECHO+ return ECHO;+#else+ return 0;+#endif++}++INLINE int+__hscore_tcsanow( void )+{+#ifdef TCSANOW+ return TCSANOW;+#else+ return 0;+#endif++}++INLINE int+__hscore_icanon( void )+{+#ifdef ICANON+ return ICANON;+#else+ return 0;+#endif+}++INLINE int __hscore_vmin( void )+{+#ifdef VMIN+ return VMIN;+#else+ return 0;+#endif+}++INLINE int __hscore_vtime( void )+{+#ifdef VTIME+ return VTIME;+#else+ return 0;+#endif+}++INLINE int __hscore_sigttou( void )+{+#ifdef SIGTTOU+ return SIGTTOU;+#else+ return 0;+#endif+}++INLINE int __hscore_sig_block( void )+{+#ifdef SIG_BLOCK+ return SIG_BLOCK;+#else+ return 0;+#endif+}++INLINE int __hscore_sig_setmask( void )+{+#ifdef SIG_SETMASK+ return SIG_SETMASK;+#else+ return 0;+#endif+}++INLINE int+__hscore_f_getfl( void )+{+#ifdef F_GETFL+ return F_GETFL;+#else+ return 0;+#endif+}++INLINE int+__hscore_f_setfl( void )+{+#ifdef F_SETFL+ return F_SETFL;+#else+ return 0;+#endif+}++// defined in rts/RtsStartup.c.+extern void* __hscore_get_saved_termios(int fd);+extern void __hscore_set_saved_termios(int fd, void* ts);++INLINE int __hscore_hs_fileno (FILE *f) { return fileno (f); }++INLINE int __hscore_open(char *file, int how, mode_t mode) {+#ifdef __MINGW32__+ if ((how & O_WRONLY) || (how & O_RDWR) || (how & O_APPEND))+ return _sopen(file,how,_SH_DENYRW,mode);+ else+ return _sopen(file,how,_SH_DENYWR,mode);+#else+ return open(file,how,mode);+#endif+}++// These are wrapped because on some OSs (eg. Linux) they are+// macros which redirect to the 64-bit-off_t versions when large file+// support is enabled.+//+#if defined(__MINGW32__)+INLINE off64_t __hscore_lseek(int fd, off64_t off, int whence) {+ return (_lseeki64(fd,off,whence));+}+#else+INLINE off_t __hscore_lseek(int fd, off_t off, int whence) {+ return (lseek(fd,off,whence));+}+#endif++INLINE HsInt __hscore_stat(char *file, struct_stat *buf) {+ return (stat(file,buf));+}++INLINE HsInt __hscore_fstat(int fd, struct_stat *buf) {+ return (fstat(fd,buf));+}++// select-related stuff++#if !defined(__MINGW32__)+INLINE int hsFD_SETSIZE(void) { return FD_SETSIZE; }+INLINE int hsFD_ISSET(int fd, fd_set *fds) { return FD_ISSET(fd, fds); }+INLINE void hsFD_SET(int fd, fd_set *fds) { FD_SET(fd, fds); }+INLINE HsInt sizeof_fd_set(void) { return sizeof(fd_set); }+extern void hsFD_ZERO(fd_set *fds);+#endif++// gettimeofday()-related++#if !defined(__MINGW32__)++INLINE HsInt sizeofTimeVal(void) { return sizeof(struct timeval); }++INLINE HsWord64 getUSecOfDay(void)+{+ struct timeval tv;+ gettimeofday(&tv, (struct timezone *) NULL);+ // Don't forget to cast *before* doing the arithmetic, otherwise+ // the arithmetic happens at the type of tv_sec, which is probably+ // only 'int'.+ return ((HsWord64)tv.tv_sec * 1000000 + (HsWord64)tv.tv_usec);+}++INLINE void setTimevalTicks(struct timeval *p, HsWord64 usecs)+{+ p->tv_sec = usecs / 1000000;+ p->tv_usec = usecs % 1000000;+}+#endif /* !defined(__MINGW32__) */++/* ToDo: write a feature test that doesn't assume 'environ' to+ * be in scope at link-time. */+extern char** environ;+INLINE char **__hscore_environ() { return environ; }++/* lossless conversions between pointers and integral types */+INLINE void * __hscore_from_uintptr(uintptr_t n) { return (void *)n; }+INLINE void * __hscore_from_intptr (intptr_t n) { return (void *)n; }+INLINE uintptr_t __hscore_to_uintptr (void *p) { return (uintptr_t)p; }+INLINE intptr_t __hscore_to_intptr (void *p) { return (intptr_t)p; }++void errorBelch2(const char*s, char *t);+void debugBelch2(const char*s, char *t);++#endif /* __HSBASE_H__ */+
@@ -0,0 +1,944 @@+/* ehclib/uhcbase/include/HsBaseConfig.h. Generated from HsBaseConfig.h.in by configure. */+#ifndef HSBASECONFIG_H+#define HSBASECONFIG_H++#include "MachDeps.h"++/********************************************************************/+/**** Sizes ****/+/********************************************************************/++#if SIZEOF_INTPTR_T == 8+#define HTYPE_INTPTR_T Int64+#define HTYPE_UINTPTR_T Word64+#else+#define HTYPE_INTPTR_T Int32+#define HTYPE_UINTPTR_T Word32+#endif++/* also here: typedef int sig_atomic_t+ */+#if SIZEOF_INT == 8+#define HTYPE_INT Int64+#define HTYPE_UNSIGNED_INT Word64+#define HTYPE_SIG_ATOMIC_T Word64+#else+#define HTYPE_INT Int32+#define HTYPE_UNSIGNED_INT Word32+#define HTYPE_SIG_ATOMIC_T Word32+#endif++#if SIZEOF_LONG == 8+#define HTYPE_LONG Int64+#define HTYPE_UNSIGNED_LONG Word64+#else+#define HTYPE_LONG Int32+#define HTYPE_UNSIGNED_LONG Word32+#endif++#if SIZEOF_VOID_P == 8+#define HTYPE_PTRDIFF_T Int64+#else+#define HTYPE_PTRDIFF_T Int32+#endif++#if SIZEOF_CLOCK_T == 8+#define HTYPE_CLOCK_T Word64+#else+#define HTYPE_CLOCK_T Word32+#endif++#if SIZEOF_TIME_T == 8+#define HTYPE_TIME_T Word64+#else+#define HTYPE_TIME_T Word32+#endif++#if SIZEOF_USECONDS_T == 8+#define HTYPE_USECONDS_T Word64+#else+#define HTYPE_USECONDS_T Word32+#endif++#if SIZEOF_SIZE_T == 8+#define HTYPE_SIZE_T Word64+#else+#define HTYPE_SIZE_T Word32+#endif++#if SIZEOF_WCHAR_T == 1+#define HTYPE_WCHAR_T Word8+#elif SIZEOF_WCHAR_T == 2+#define HTYPE_WCHAR_T Word16+#else+#define HTYPE_WCHAR_T Word32+#endif++++/* Define to Haskell type for char */+#define HTYPE_CHAR Int8++/* Define to Haskell type for double */+#define HTYPE_DOUBLE Double++/* Define to Haskell type for float */+#define HTYPE_FLOAT Float++/* Define to Haskell type for intmax_t */+#define HTYPE_INTMAX_T Int64++/* Define to Haskell type for long long */+#define HTYPE_LONG_LONG Int64++/* Define to Haskell type for short */+#define HTYPE_SHORT Int16++/* Define to Haskell type for signed char */+#define HTYPE_SIGNED_CHAR Int8++/* Define to Haskell type for uintmax_t */+#define HTYPE_UINTMAX_T Word64++/* Define to Haskell type for unsigned char */+#define HTYPE_UNSIGNED_CHAR Word8++/* Define to Haskell type for unsigned long long */+#define HTYPE_UNSIGNED_LONG_LONG Word64++/* Define to Haskell type for unsigned short */+#define HTYPE_UNSIGNED_SHORT Word16++++/********************************************************************/+/**** System tupes ****/+/********************************************************************/++#ifdef SIZEOF_DEV_T+# if SIZEOF_DEV_T == 8+# define HTYPE_DEV_T Word64+# elif SIZEOF_DEV_T == 4+# define HTYPE_DEV_T Word32+# elif SIZEOF_DEV_T == 2+# define HTYPE_DEV_T Word16+# else+# endif+#endif++#ifdef SIZEOF_INO_T+# if SIZEOF_INO_T == 8+# define HTYPE_INO_T Word64+# elif SIZEOF_INO_T == 4+# define HTYPE_INO_T Word32+# elif SIZEOF_INO_T == 2+# define HTYPE_INO_T Word16+# else+# endif+#endif++#ifdef SIZEOF_MODE_T+# if SIZEOF_MODE_T == 8+# define HTYPE_MODE_T Word64+# elif SIZEOF_MODE_T == 4+# define HTYPE_MODE_T Word32+# elif SIZEOF_MODE_T == 2+# define HTYPE_MODE_T Word16+# else+# endif+#endif++#ifdef SIZEOF_OFF_T+# if SIZEOF_OFF_T == 8+# define HTYPE_OFF_T Word64+# elif SIZEOF_OFF_T == 4+# define HTYPE_OFF_T Word32+# elif SIZEOF_OFF_T == 2+# define HTYPE_OFF_T Word16+# else+# endif+#endif++#ifdef SIZEOF_PID_T+# if SIZEOF_PID_T == 8+# define HTYPE_PID_T Word64+# elif SIZEOF_PID_T == 4+# define HTYPE_PID_T Word32+# elif SIZEOF_PID_T == 2+# define HTYPE_PID_T Word16+# else+# endif+#endif++#ifdef SIZEOF_SSIZE_T+# if SIZEOF_SSIZE_T == 8+# define HTYPE_SSIZE_T Word64+# elif SIZEOF_SSIZE_T == 4+# define HTYPE_SSIZE_T Word32+# elif SIZEOF_SSIZE_T == 2+# define HTYPE_SSIZE_T Word16+# else+# endif+#endif++#ifdef SIZEOF_GID_T+# if SIZEOF_GID_T == 8+# define HTYPE_GID_T Word64+# elif SIZEOF_GID_T == 4+# define HTYPE_GID_T Word32+# elif SIZEOF_GID_T == 2+# define HTYPE_GID_T Word16+# else+# endif+#endif++#ifdef SIZEOF_NLINK_T+# if SIZEOF_NLINK_T == 8+# define HTYPE_NLINK_T Word64+# elif SIZEOF_NLINK_T == 4+# define HTYPE_NLINK_T Word32+# elif SIZEOF_NLINK_T == 2+# define HTYPE_NLINK_T Word16+# else+# endif+#endif++#ifdef SIZEOF_UID_T+# if SIZEOF_UID_T == 8+# define HTYPE_UID_T Word64+# elif SIZEOF_UID_T == 4+# define HTYPE_UID_T Word32+# elif SIZEOF_UID_T == 2+# define HTYPE_UID_T Word16+# else+# endif+#endif++#ifdef SIZEOF_CC_T+# if SIZEOF_CC_T == 8+# define HTYPE_CC_T Word64+# elif SIZEOF_CC_T == 4+# define HTYPE_CC_T Word32+# elif SIZEOF_CC_T == 2+# define HTYPE_CC_T Word16+# else+# endif+#endif++#ifdef SIZEOF_SPEED_T+# if SIZEOF_SPEED_T == 8+# define HTYPE_SPEED_T Word64+# elif SIZEOF_SPEED_T == 4+# define HTYPE_SPEED_T Word32+# elif SIZEOF_SPEED_T == 2+# define HTYPE_SPEED_T Word16+# else+# endif+#endif++#ifdef SIZEOF_TCFLAG_T+# if SIZEOF_TCFLAG_T == 8+# define HTYPE_TCFLAG_T Word64+# elif SIZEOF_TCFLAG_T == 4+# define HTYPE_TCFLAG_T Word32+# elif SIZEOF_TCFLAG_T == 2+# define HTYPE_TCFLAG_T Word16+# else+# endif+#endif++#ifdef SIZEOF_RLIM_T+# if SIZEOF_RLIM_T == 8+# define HTYPE_RLIM_T Word64+# elif SIZEOF_RLIM_T == 4+# define HTYPE_RLIM_T Word32+# elif SIZEOF_RLIM_T == 2+# define HTYPE_RLIM_T Word16+# else+# endif+#endif++/********************************************************************/+/**** Presence of include files ****/+/********************************************************************/++#define HAVE_DIRENT_H 1+#define HAVE_ERRNO_H 1+#define HAVE_FCNTL_H 1+#define HAVE_INTTYPES_H 1+#define HAVE_LIMITS_H 1+#define HAVE_SIGNAL_H 1+#define HAVE_STDINT_H 1+#define HAVE_STRING_H 1+#define HAVE_SYS_RESOURCE_H 1+#define HAVE_SYS_SELECT_H 1+#define HAVE_SYS_STAT_H 1+#define HAVE_SYS_SYSCALL_H 1+#define HAVE_SYS_TIME_H 1+#define HAVE_SYS_TIMEB_H 1+/* #undef HAVE_SYS_TIMERS_H */+#define HAVE_SYS_TIMES_H 1+#define HAVE_SYS_TYPES_H 1+#define HAVE_SYS_UTSNAME_H 1+#define HAVE_SYS_WAIT_H 1+#define HAVE_TERMIOS_H 1+#define HAVE_TIME_H 1+#define HAVE_UNISTD_H 1+#define HAVE_UTIME_H 1+/* #undef HAVE_VFORK_H */+#define HAVE_WCTYPE_H 1+/* #undef HAVE_WINDOWS_H */+/* #undef HAVE_WINSOCK_H */++/* #undef HAVE__CHSIZE */+#define HAVE_FTRUNCATE 1+/* #undef HAVE_GETCLOCK */+#define HAVE_GETRUSAGE 1+#define HAVE_GETTIMEOFDAY 1+#define HAVE_LSTAT 1+#define HAVE_READDIR_R 1++/********************************************************************/+/**** Runtime types ****/+/********************************************************************/++#ifdef __UHC_BUILDS_O__++#if defined(__UHC_TARGET_BC__) || defined(__UHC_TARGET_C__)+// # define HsBool Word+// # define HsInt Word+// # define HsWord64 Word64+// # define HsWord32 Word32+// # define HsWord16 Word16+// # define HsWord8 Word8+// # ifdef __UHC_TARGET_BC__+// # define HS_BOOL_FALSE gb_False+// # define HS_BOOL_TRUE gb_True+// # else+// # define HS_BOOL_FALSE 0+// # define HS_BOOL_TRUE 1+// # endif+#endif /* __UHC_TARGET_BC__ */++#endif /* __UHC_BUILDS_O__ */++/********************************************************************/+/**** Read dir EOF error ****/+/********************************************************************/++/* See remarks in GHC, libraries/base/aclocal.m4: MinGW platform returns non 0 value. We ignore that */+#define READDIR_ERRNO_EOF 0++/********************************************************************/+/**** C errors ****/+/********************************************************************/++/* (1) Assume errno.h is already included */+/* (2) Error codes like EADV are not present on all platforms, so a dummy value is provided, this should be done for all codes */++/* The value of E2BIG. */+#if !defined(E2BIG)+#define E2BIG 10000+#endif+#define CONST_E2BIG E2BIG++/* The value of EACCES. */+#if !defined(EACCES)+#define EACCES 10000+#endif+#define CONST_EACCES EACCES++/* The value of EADDRINUSE. */+#if !defined(EADDRINUSE)+#define EADDRINUSE 10000+#endif+#define CONST_EADDRINUSE EADDRINUSE++/* The value of EADDRNOTAVAIL. */+#define CONST_EADDRNOTAVAIL EADDRNOTAVAIL++/* The value of EADV. */+#if !defined(EADV)+#define EADV 10000+#endif+#define CONST_EADV EADV++/* The value of EAFNOSUPPORT. */+#if !defined(EAFNOSUPPORT)+#define EAFNOSUPPORT 10000+#endif+#define CONST_EAFNOSUPPORT EAFNOSUPPORT++/* The value of EAGAIN. */+#if !defined(EAGAIN)+#define EAGAIN 10000+#endif+#define CONST_EAGAIN EAGAIN++/* The value of EALREADY. */+#if !defined(EALREADY)+#define EALREADY 10000+#endif+#define CONST_EALREADY EALREADY++/* The value of EBADF. */+#if !defined(EBADF)+#define EBADF 10000+#endif+#define CONST_EBADF EBADF++/* The value of EBADMSG. */+#if !defined(EBADMSG)+#define EBADMSG 10000+#endif+#define CONST_EBADMSG EBADMSG++/* The value of EBADRPC. */+#if !defined(EBADRPC)+#define EBADRPC 10000+#endif+#define CONST_EBADRPC EBADRPC++/* The value of EBUSY. */+#if !defined(EBUSY)+#define EBUSY 10000+#endif+#define CONST_EBUSY EBUSY++/* The value of ECHILD. */+#if !defined(ECHILD)+#define ECHILD 10000+#endif+#define CONST_ECHILD ECHILD++/* The value of ECOMM. */+#if !defined(ECOMM)+#define ECOMM 10000+#endif+#define CONST_ECOMM ECOMM++/* The value of ECONNABORTED. */+#if !defined(ECONNABORTED)+#define ECONNABORTED 10000+#endif+#define CONST_ECONNABORTED ECONNABORTED++/* The value of ECONNREFUSED. */+#if !defined(ECONNREFUSED)+#define ECONNREFUSED 10000+#endif+#define CONST_ECONNREFUSED ECONNREFUSED++/* The value of ECONNRESET. */+#if !defined(ECONNRESET)+#define ECONNRESET 10000+#endif+#define CONST_ECONNRESET ECONNRESET++/* The value of EDEADLK. */+#if !defined(EDEADLK)+#define EDEADLK 10000+#endif+#define CONST_EDEADLK EDEADLK++/* The value of EDESTADDRREQ. */+#if !defined(EDESTADDRREQ)+#define EDESTADDRREQ 10000+#endif+#define CONST_EDESTADDRREQ EDESTADDRREQ++/* The value of EDIRTY. */+#if !defined(EDIRTY)+#define EDIRTY 10000+#endif+#define CONST_EDIRTY EDIRTY++/* The value of EDOM. */+#if !defined(EDOM)+#define EDOM 10000+#endif+#define CONST_EDOM EDOM++/* The value of EDQUOT. */+#if !defined(EDQUOT)+#define EDQUOT 10000+#endif+#define CONST_EDQUOT EDQUOT++/* The value of EEXIST. */+#if !defined(EEXIST)+#define EEXIST 10000+#endif+#define CONST_EEXIST EEXIST++/* The value of EFAULT. */+#if !defined(EFAULT)+#define EFAULT 10000+#endif+#define CONST_EFAULT EFAULT++/* The value of EFBIG. */+#if !defined(EFBIG)+#define EFBIG 10000+#endif+#define CONST_EFBIG EFBIG++/* The value of EFTYPE. */+#if !defined(EFTYPE)+#define EFTYPE 10000+#endif+#define CONST_EFTYPE EFTYPE++/* The value of EHOSTDOWN. */+#if !defined(EHOSTDOWN)+#define EHOSTDOWN 10000+#endif+#define CONST_EHOSTDOWN EHOSTDOWN++/* The value of EHOSTUNREACH. */+#if !defined(EHOSTUNREACH)+#define EHOSTUNREACH 10000+#endif+#define CONST_EHOSTUNREACH EHOSTUNREACH++/* The value of EIDRM. */+#if !defined(EIDRM)+#define EIDRM 10000+#endif+#define CONST_EIDRM EIDRM++/* The value of EILSEQ. */+#if !defined(EILSEQ)+#define EILSEQ 10000+#endif+#define CONST_EILSEQ EILSEQ++/* The value of EINPROGRESS. */+#if !defined(EINPROGRESS)+#define EINPROGRESS 10000+#endif+#define CONST_EINPROGRESS EINPROGRESS++/* The value of EINTR. */+#if !defined(EINTR)+#define EINTR 10000+#endif+#define CONST_EINTR EINTR++/* The value of EINVAL. */+#if !defined(EINVAL)+#define EINVAL 10000+#endif+#define CONST_EINVAL EINVAL++/* The value of EIO. */+#if !defined(EIO)+#define EIO 10000+#endif+#define CONST_EIO EIO++/* The value of EISCONN. */+#if !defined(EISCONN)+#define EISCONN 10000+#endif+#define CONST_EISCONN EISCONN++/* The value of EISDIR. */+#if !defined(EISDIR)+#define EISDIR 10000+#endif+#define CONST_EISDIR EISDIR++/* The value of ELOOP. */+#if !defined(ELOOP)+#define ELOOP 10000+#endif+#define CONST_ELOOP ELOOP++/* The value of EMFILE. */+#if !defined(EMFILE)+#define EMFILE 10000+#endif+#define CONST_EMFILE EMFILE++/* The value of EMLINK. */+#if !defined(EMLINK)+#define EMLINK 10000+#endif+#define CONST_EMLINK EMLINK++/* The value of EMSGSIZE. */+#if !defined(EMSGSIZE)+#define EMSGSIZE 10000+#endif+#define CONST_EMSGSIZE EMSGSIZE++/* The value of EMULTIHOP. */+#if !defined(EMULTIHOP)+#define EMULTIHOP 10000+#endif+#define CONST_EMULTIHOP EMULTIHOP++/* The value of ENAMETOOLONG. */+#if !defined(ENAMETOOLONG)+#define ENAMETOOLONG 10000+#endif+#define CONST_ENAMETOOLONG ENAMETOOLONG++/* The value of ENETDOWN. */+#if !defined(ENETDOWN)+#define ENETDOWN 10000+#endif+#define CONST_ENETDOWN ENETDOWN++/* The value of ENETRESET. */+#if !defined(ENETRESET)+#define ENETRESET 10000+#endif+#define CONST_ENETRESET ENETRESET++/* The value of ENETUNREACH. */+#if !defined(ENETUNREACH)+#define ENETUNREACH 10000+#endif+#define CONST_ENETUNREACH ENETUNREACH++/* The value of ENFILE. */+#if !defined(ENFILE)+#define ENFILE 10000+#endif+#define CONST_ENFILE ENFILE++/* The value of ENOBUFS. */+#if !defined(ENOBUFS)+#define ENOBUFS 10000+#endif+#define CONST_ENOBUFS ENOBUFS++/* The value of ENOCIGAR. */+#if !defined(ENOCIGAR)+#define ENOCIGAR 10000+#endif+#define CONST_ENOCIGAR ENOCIGAR++/* The value of ENODATA. */+#if !defined(ENODATA)+#define ENODATA 10000+#endif+#define CONST_ENODATA ENODATA++/* The value of ENODEV. */+#if !defined(ENODEV)+#define ENODEV 10000+#endif+#define CONST_ENODEV ENODEV++/* The value of ENOENT. */+#if !defined(ENOENT)+#define ENOENT 10000+#endif+#define CONST_ENOENT ENOENT++/* The value of ENOEXEC. */+#if !defined(ENOEXEC)+#define ENOEXEC 10000+#endif+#define CONST_ENOEXEC ENOEXEC++/* The value of ENOLCK. */+#if !defined(ENOLCK)+#define ENOLCK 10000+#endif+#define CONST_ENOLCK ENOLCK++/* The value of ENOLINK. */+#if !defined(ENOLINK)+#define ENOLINK 10000+#endif+#define CONST_ENOLINK ENOLINK++/* The value of ENOMEM. */+#if !defined(ENOMEM)+#define ENOMEM 10000+#endif+#define CONST_ENOMEM ENOMEM++/* The value of ENOMSG. */+#if !defined(ENOMSG)+#define ENOMSG 10000+#endif+#define CONST_ENOMSG ENOMSG++/* The value of ENONET. */+#if !defined(ENONET)+#define ENONET 10000+#endif+#define CONST_ENONET ENONET++/* The value of ENOPROTOOPT. */+#if !defined(ENOPROTOOPT)+#define ENOPROTOOPT 10000+#endif+#define CONST_ENOPROTOOPT ENOPROTOOPT++/* The value of ENOSPC. */+#if !defined(ENOSPC)+#define ENOSPC 10000+#endif+#define CONST_ENOSPC ENOSPC++/* The value of ENOSR. */+#if !defined(ENOSR)+#define ENOSR 10000+#endif+#define CONST_ENOSR ENOSR++/* The value of ENOSTR. */+#if !defined(ENOSTR)+#define ENOSTR 10000+#endif+#define CONST_ENOSTR ENOSTR++/* The value of ENOSYS. */+#if !defined(ENOSYS)+#define ENOSYS 10000+#endif+#define CONST_ENOSYS ENOSYS++/* The value of ENOTBLK. */+#if !defined(ENOTBLK)+#define ENOTBLK 10000+#endif+#define CONST_ENOTBLK ENOTBLK++/* The value of ENOTCONN. */+#if !defined(ENOTCONN)+#define ENOTCONN 10000+#endif+#define CONST_ENOTCONN ENOTCONN++/* The value of ENOTDIR. */+#if !defined(ENOTDIR)+#define ENOTDIR 10000+#endif+#define CONST_ENOTDIR ENOTDIR++/* The value of ENOTEMPTY. */+#if !defined(ENOTEMPTY)+#define ENOTEMPTY 10000+#endif+#define CONST_ENOTEMPTY ENOTEMPTY++/* The value of ENOTSOCK. */+#if !defined(ENOTSOCK)+#define ENOTSOCK 10000+#endif+#define CONST_ENOTSOCK ENOTSOCK++/* The value of ENOTTY. */+#if !defined(ENOTTY)+#define ENOTTY 10000+#endif+#define CONST_ENOTTY ENOTTY++/* The value of ENXIO. */+#if !defined(ENXIO)+#define ENXIO 10000+#endif+#define CONST_ENXIO ENXIO++/* The value of EOPNOTSUPP. */+#if !defined(EOPNOTSUPP)+#define EOPNOTSUPP 10000+#endif+#define CONST_EOPNOTSUPP EOPNOTSUPP++/* The value of EPERM. */+#if !defined(EPERM)+#define EPERM 10000+#endif+#define CONST_EPERM EPERM++/* The value of EPFNOSUPPORT. */+#if !defined(EPFNOSUPPORT)+#define EPFNOSUPPORT 10000+#endif+#define CONST_EPFNOSUPPORT EPFNOSUPPORT++/* The value of EPIPE. */+#if !defined(EPIPE)+#define EPIPE 10000+#endif+#define CONST_EPIPE EPIPE++/* The value of EPROCLIM. */+#if !defined(EPROCLIM)+#define EPROCLIM 10000+#endif+#define CONST_EPROCLIM EPROCLIM++/* The value of EPROCUNAVAIL. */+#if !defined(EPROCUNAVAIL)+#define EPROCUNAVAIL 10000+#endif+#define CONST_EPROCUNAVAIL EPROCUNAVAIL++/* The value of EPROGMISMATCH. */+#if !defined(EPROGMISMATCH)+#define EPROGMISMATCH 10000+#endif+#define CONST_EPROGMISMATCH EPROGMISMATCH++/* The value of EPROGUNAVAIL. */+#if !defined(EPROGUNAVAIL)+#define EPROGUNAVAIL 10000+#endif+#define CONST_EPROGUNAVAIL EPROGUNAVAIL++/* The value of EPROTO. */+#if !defined(EPROTO)+#define EPROTO 10000+#endif+#define CONST_EPROTO EPROTO++/* The value of EPROTONOSUPPORT. */+#if !defined(EPROTONOSUPPORT)+#define EPROTONOSUPPORT 10000+#endif+#define CONST_EPROTONOSUPPORT EPROTONOSUPPORT++/* The value of EPROTOTYPE. */+#if !defined(EPROTOTYPE)+#define EPROTOTYPE 10000+#endif+#define CONST_EPROTOTYPE EPROTOTYPE++/* The value of ERANGE. */+#if !defined(ERANGE)+#define ERANGE 10000+#endif+#define CONST_ERANGE ERANGE++/* The value of EREMCHG. */+#if !defined(EREMCHG)+#define EREMCHG 10000+#endif+#define CONST_EREMCHG EREMCHG++/* The value of EREMOTE. */+#if !defined(EREMOTE)+#define EREMOTE 10000+#endif+#define CONST_EREMOTE EREMOTE++/* The value of EROFS. */+#if !defined(EROFS)+#define EROFS 10000+#endif+#define CONST_EROFS EROFS++/* The value of ERPCMISMATCH. */+#if !defined(ERPCMISMATCH)+#define ERPCMISMATCH 10000+#endif+#define CONST_ERPCMISMATCH ERPCMISMATCH++/* The value of ERREMOTE. */+#if !defined(ERREMOTE)+#define ERREMOTE 10000+#endif+#define CONST_ERREMOTE ERREMOTE++/* The value of ESHUTDOWN. */+#if !defined(ESHUTDOWN)+#define ESHUTDOWN 10000+#endif+#define CONST_ESHUTDOWN ESHUTDOWN++/* The value of ESOCKTNOSUPPORT. */+#if !defined(ESOCKTNOSUPPORT)+#define ESOCKTNOSUPPORT 10000+#endif+#define CONST_ESOCKTNOSUPPORT ESOCKTNOSUPPORT++/* The value of ESPIPE. */+#if !defined(ESPIPE)+#define ESPIPE 10000+#endif+#define CONST_ESPIPE ESPIPE++/* The value of ESRCH. */+#if !defined(ESRCH)+#define ESRCH 10000+#endif+#define CONST_ESRCH ESRCH++/* The value of ESRMNT. */+#if !defined(ESRMNT)+#define ESRMNT 10000+#endif+#define CONST_ESRMNT ESRMNT++/* The value of ESTALE. */+#if !defined(ESTALE)+#define ESTALE 10000+#endif+#define CONST_ESTALE ESTALE++/* The value of ETIME. */+#if !defined(ETIME)+#define ETIME 10000+#endif+#define CONST_ETIME ETIME++/* The value of ETIMEDOUT. */+#if !defined(ETIMEDOUT)+#define ETIMEDOUT 10000+#endif+#define CONST_ETIMEDOUT ETIMEDOUT++/* The value of ETOOMANYREFS. */+#if !defined(ETOOMANYREFS)+#define ETOOMANYREFS 10000+#endif+#define CONST_ETOOMANYREFS ETOOMANYREFS++/* The value of ETXTBSY. */+#if !defined(ETXTBSY)+#define ETXTBSY 10000+#endif+#define CONST_ETXTBSY ETXTBSY++/* The value of EUSERS. */+#if !defined(EUSERS)+#define EUSERS 10000+#endif+#define CONST_EUSERS EUSERS++/* The value of EWOULDBLOCK. */+#if !defined(EWOULDBLOCK)+#define EWOULDBLOCK 10000+#endif+#define CONST_EWOULDBLOCK EWOULDBLOCK++/* The value of EXDEV. */+#if !defined(EXDEV)+#define EXDEV 10000+#endif+#define CONST_EXDEV EXDEV++/* The value of O_BINARY. */+#if !defined(O_BINARY)+#define O_BINARY 10000+#endif+#define CONST_O_BINARY O_BINARY++/* The value of SIGINT. */+#if !defined(SIGINT)+#define SIGINT 10000+#endif+#define CONST_SIGINT SIGINT+++#endif+
@@ -0,0 +1,242 @@+{- --------------------------------------------------------------------------+// Macros to help make various instances for Int like types (Int8, ...).+//+// Primitives are defined by 2 forms of macros:+// - starting with PRIMS_ : name of Haskell function and primitive is the same+// - starting with PRIMS2_ : name of primitive is given explicitly, to allow sharing between primitives+// --------------------------------------------------------------------------+-}++-- define conversion primitives+#define PRIMS_CONVERSION_INTEGER(tycon,primIntegerTo,primToInteger) \+foreign import prim primIntegerTo :: Integer -> tycon ; \+foreign import prim primToInteger :: tycon -> Integer ++#define PRIMS2_CONVERSION_INTEGER(tycon,primIntegerTo,primIntegerToNm,primToInteger,primToIntegerNm) \+foreign import prim primIntegerToNm primIntegerTo :: Integer -> tycon ; \+foreign import prim primToIntegerNm primToInteger :: tycon -> Integer ++#define PRIMS_CONVERSION_INT(tycon,primIntTo,primToInt) \+foreign import prim primIntTo :: Int -> tycon ; \+foreign import prim primToInt :: tycon -> Int +++-- define Eq primitives+#define PRIMS_EQ(tycon,primEq,primNe) \+foreign import prim primEq :: tycon -> tycon -> Bool ; \+foreign import prim primNe :: tycon -> tycon -> Bool ++#define PRIMS2_EQ(tycon,primEq,primEqNm,primNe,primNeNm) \+foreign import prim primEqNm primEq :: tycon -> tycon -> Bool ; \+foreign import prim primNeNm primNe :: tycon -> tycon -> Bool+++-- define Eq instance+#define INSTANCE_EQ(tycon,primEq,primNe) \+instance Eq tycon where \+ { (==) = primEq ; \+ (/=) = primNe \+ }+++-- define Ord primitives++#define PRIMS_ORD(tycon,primCmp,primLt,primGt,primLe,primGe) \+foreign import prim primCmp :: tycon -> tycon -> Ordering ; \+foreign import prim primLt :: tycon -> tycon -> Bool ; \+foreign import prim primGt :: tycon -> tycon -> Bool ; \+foreign import prim primLe :: tycon -> tycon -> Bool ; \+foreign import prim primGe :: tycon -> tycon -> Bool ++#define PRIMS2_ORD(tycon,primCmp,primCmpNm,primLt,primLtNm,primGt,primGtNm,primLe,primLeNm,primGe,primGeNm) \+foreign import prim primCmpNm primCmp :: tycon -> tycon -> Ordering ; \+foreign import prim primLtNm primLt :: tycon -> tycon -> Bool ; \+foreign import prim primGtNm primGt :: tycon -> tycon -> Bool ; \+foreign import prim primLeNm primLe :: tycon -> tycon -> Bool ; \+foreign import prim primGeNm primGe :: tycon -> tycon -> Bool +++-- define Ord instance++#define INSTANCE_ORD(tycon,primCmp,primLt,primGt,primLe,primGe) \+instance Ord tycon where \+ { compare = primCmp \+ ; (<) = primLt \+ ; (>) = primGt \+ ; (<=) = primLe \+ ; (>=) = primGe \+ }+++-- define Bounded primitives+#define PRIMS_BOUNDED(tycon,primMin,primMax) \+foreign import prim primMin :: tycon ; \+foreign import prim primMax :: tycon +++-- define Bounded instance+#define INSTANCE_BOUNDED(tycon,primMin,primMax) \+instance Bounded tycon where \+ { minBound = primMin \+ ; maxBound = primMax \+ }+++-- define Num primitives+#define PRIMS_NUM(tycon,primAdd,primSub,primMul,primNeg) \+foreign import prim primAdd :: tycon -> tycon -> tycon ; \+foreign import prim primSub :: tycon -> tycon -> tycon ; \+foreign import prim primMul :: tycon -> tycon -> tycon ; \+foreign import prim primNeg :: tycon -> tycon ++#define PRIMS2_NUM(tycon,primAdd,primAddNm,primSub,primSubNm,primMul,primMulNm,primNeg,primNegNm) \+foreign import prim primAddNm primAdd :: tycon -> tycon -> tycon ; \+foreign import prim primSubNm primSub :: tycon -> tycon -> tycon ; \+foreign import prim primMulNm primMul :: tycon -> tycon -> tycon ; \+foreign import prim primNegNm primNeg :: tycon -> tycon +++-- define Num instance+#define INSTANCE_NUM(tycon,primAdd,primSub,primMul,primNeg,primIntegerTo,primIntTo) \+instance Num tycon where \+ { (+) = primAdd \+ ; (-) = primSub \+ ; (*) = primMul \+ ; negate = primNeg \+ ; fromInteger = primIntegerTo \+ ; fromInt = primIntTo \+ ; abs = absReal \+ ; signum = signumReal \+ }+++-- define Enum instance+#define INSTANCE_ENUM(tycon,primToEnum,primFromEnum) \+instance Enum tycon where \+ { succ = boundedSucc \+ ; pred = boundedPred \+ ; toEnum = primToEnum \+ ; fromEnum = primFromEnum \+ ; enumFrom = boundedEnumFrom \+ ; enumFromTo = boundedEnumFromTo \+ ; enumFromThen = boundedEnumFromThen \+ ; enumFromThenTo = boundedEnumFromThenTo \+ }+++-- define Real instance+#define INSTANCE_REAL(tycon) \+instance Real tycon where \+ { toRational x = toInteger x % 1 \+ }+++-- define Integral primitives+#define PRIMS_INTEGRAL1(tycon,primDiv,primMod,primQuot,primRem) \+foreign import prim primDiv :: tycon -> tycon -> tycon ; \+foreign import prim primMod :: tycon -> tycon -> tycon ; \+foreign import prim primQuot :: tycon -> tycon -> tycon ; \+foreign import prim primRem :: tycon -> tycon -> tycon ++#define PRIMS2_INTEGRAL1(tycon,primDiv,primDivNm,primMod,primModNm,primQuot,primQuotNm,primRem,primRemNm) \+foreign import prim primDivNm primDiv :: tycon -> tycon -> tycon ; \+foreign import prim primModNm primMod :: tycon -> tycon -> tycon ; \+foreign import prim primQuotNm primQuot :: tycon -> tycon -> tycon ; \+foreign import prim primRemNm primRem :: tycon -> tycon -> tycon ++#define PRIMS_INTEGRAL2(tycon,primDiv,primMod,primDivMod,primQuot,primRem,primQuotRem) \+PRIMS_INTEGRAL1(tycon,primDiv,primMod,primQuot,primRem) ; \+foreign import prim primDivMod :: tycon -> tycon -> (tycon,tycon) ; \+foreign import prim primQuotRem :: tycon -> tycon -> (tycon,tycon) ++#define PRIMS2_INTEGRAL2(tycon,primDiv,primDivNm,primMod,primModNm,primDivMod,primDivModNm,primQuot,primQuotNm,primRem,primRemNm,primQuotRem,primQuotRemNm) \+PRIMS2_INTEGRAL1(tycon,primDiv,primDivNm,primMod,primModNm,primQuot,primQuotNm,primRem,primQuotRemNm) ; \+foreign import prim primDivModNm primDivMod :: tycon -> tycon -> (tycon,tycon) ; \+foreign import prim primQuotRemNm primQuotRem :: tycon -> tycon -> (tycon,tycon) +++-- define Integral instance, assume default for divMod+#define INSTANCE_INTEGRAL1(tycon,primDiv,primMod,primQuot,primRem,primToInteger,primToInt) \+instance Integral tycon where \+ { quotRem d m \+ = (primQuot d m, primRem d m) \+ ; div = primDiv \+ ; quot = primQuot \+ ; rem = primRem \+ ; mod = primMod \+ ; toInteger = primToInteger \+ ; toInt = primToInt \+ }++#define INSTANCE_INTEGRAL2(tycon,primDiv,primMod,primDivMod,primQuot,primRem,primQuotRem,primToInteger,primToInt) \+instance Integral tycon where \+ { divMod = primDivMod \+ ; quotRem = primQuotRem \+ ; div = primDiv \+ ; quot = primQuot \+ ; rem = primRem \+ ; mod = primMod \+ ; toInteger = primToInteger \+ ; toInt = primToInt \+ }+++-- define Show instance+#define INSTANCE_SHOW(tycon) \+instance Show tycon where \+ { show = show . toInteger \+ }+++-- define Read instance+#define INSTANCE_READ(tycon) \+instance Read tycon where \+ { readsPrec p = readSigned readDec \+ }+++-- define Bits primitives+#define PRIMS_BITLOGIC(tycon,primAnd,primOr,primXor) \+foreign import prim primAnd :: tycon -> tycon -> tycon ; \+foreign import prim primOr :: tycon -> tycon -> tycon ; \+foreign import prim primXor :: tycon -> tycon -> tycon++#define PRIMS_BITSHIFT(tycon,primComplement,primShiftLeft,primShiftRight,primRotateLeft,primRotateRight) \+foreign import prim primComplement :: tycon -> tycon ; \+foreign import prim primShiftLeft :: tycon -> Int -> tycon ; \+foreign import prim primShiftRight :: tycon -> Int -> tycon ; \+foreign import prim primRotateLeft :: tycon -> Int -> tycon ; \+foreign import prim primRotateRight :: tycon -> Int -> tycon++#define PRIMS2_BITLOGIC(tycon,primAnd,primAndNm,primOr,primOrNm,primXor,primXorNm) \+foreign import prim primAndNm primAnd :: tycon -> tycon -> tycon ; \+foreign import prim primOrNm primOr :: tycon -> tycon -> tycon ; \+foreign import prim primXorNm primXor :: tycon -> tycon -> tycon++#define PRIMS2_BITSHIFT(tycon,primComplement,primComplementNm,primShiftLeft,primShiftLeftNm,primShiftRight,primShiftRightNm,primRotateLeft,primRotateLeftNm,primRotateRight,primRotateRightNm) \+foreign import prim primComplementNm primComplement :: tycon -> tycon ; \+foreign import prim primShiftLeftNm primShiftLeft :: tycon -> Int -> tycon ; \+foreign import prim primShiftRightNm primShiftRight :: tycon -> Int -> tycon ; \+foreign import prim primRotateLeftNm primRotateLeft :: tycon -> Int -> tycon ; \+foreign import prim primRotateRightNm primRotateRight :: tycon -> Int -> tycon++-- define Bits instance+#define INSTANCE_BITS1(tycon,size,signed,primAnd,primOr,primXor,primComplement,primShiftLeft,primShiftRight,primRotateLeft,primRotateRight) \+instance Bits tycon where \+ { (.&.) = primAnd \+ ; (.|.) = primOr \+ ; xor = primXor \+ ; complement = primComplement \+ ; shiftL = primShiftLeft \+ ; shiftR = primShiftRight \+ ; rotateL = primRotateLeft \+ ; rotateR = primRotateRight \+ ; bitSize _ = size \+ ; isSigned _ = signed \+ }++++++
@@ -0,0 +1,125 @@+/* ehclib/uhcbase/include/MachDeps.h. Generated from MachDeps.h.in by configure. */+#ifndef MACHDEPS_H+#define MACHDEPS_H++#define SIZEOF_INTPTR_T 8+#define SIZEOF_CHAR 1+#define SIZEOF_SHORT 2+#define SIZEOF_INT 4+#define SIZEOF_LONG 8+#define SIZEOF_LONG_LONG 8+#define SIZEOF_FLOAT 4+#define SIZEOF_DOUBLE 8+#define SIZEOF_UNSIGNED_CHAR 1+#define SIZEOF_UNSIGNED_SHORT 2+#define SIZEOF_UNSIGNED_INT 4+#define SIZEOF_UNSIGNED_LONG 8+#define SIZEOF_UNSIGNED_LONG_LONG 8+#define SIZEOF_VOID_P 8++#define SIZEOF_DEV_T 4+#define SIZEOF_INO_T 8+#define SIZEOF_OFF_T 8+#define SIZEOF_MODE_T 2+#define SIZEOF_PID_T 4+#define SIZEOF_SSIZE_T 8+#define SIZEOF_GID_T 4+#define SIZEOF_NLINK_T 2+#define SIZEOF_UID_T 4+#define SIZEOF_RLIM_T 8+#define SIZEOF_CLOCK_T 8+#define SIZEOF_TIME_T 8+#define SIZEOF_SIZE_T 8+#define SIZEOF_WCHAR_T 4++#define SIZEOF_CC_T 1+#define SIZEOF_SPEED_T 8+#define SIZEOF_TCFLAG_T 8++#define ALIGNOF_INTPTR_T 8+#define ALIGNOF_CHAR 1+#define ALIGNOF_SHORT 2+#define ALIGNOF_INT 4+#define ALIGNOF_LONG 8+#define ALIGNOF_LONG_LONG 8+#define ALIGNOF_FLOAT 4+#define ALIGNOF_DOUBLE 8+#define ALIGNOF_UNSIGNED_CHAR 1+#define ALIGNOF_UNSIGNED_SHORT 2+#define ALIGNOF_UNSIGNED_INT 4+#define ALIGNOF_UNSIGNED_LONG 8+#define ALIGNOF_UNSIGNED_LONG_LONG 8+#define ALIGNOF_VOID_P 8++#define ALIGNOF_UINT8_T 1+#define ALIGNOF_UINT16_T 2+#define ALIGNOF_UINT32_T 4+#define ALIGNOF_UINT64_T 8++#if SIZEOF_INTPTR_T == 8+#define USE_64_BITS 1+#define USE_32_BITS 0+#else+#define USE_64_BITS 0+#define USE_32_BITS 1+#endif++#ifdef __UHC_TARGET_BC__+#define BITSIZEOF_WORDTAG 1+#else+#define BITSIZEOF_WORDTAG 0+#endif++#define SIZEOF_HSCHAR SIZEOF_INTPTR_T+#define ALIGNMENT_HSCHAR ALIGNOF_UINT32_T++#define SIZEOF_HSINT SIZEOF_INTPTR_T+#define ALIGNMENT_HSINT ALIGNOF_INTPTR_T++#define SIZEOF_HSWORD SIZEOF_INTPTR_T+#define ALIGNMENT_HSWORD ALIGNOF_INTPTR_T++#define SIZEOF_HSDOUBLE SIZEOF_DOUBLE+#define ALIGNMENT_HSDOUBLE ALIGNOF_DOUBLE++#define SIZEOF_HSFLOAT SIZEOF_FLOAT+#define ALIGNMENT_HSFLOAT ALIGNOF_FLOAT++#define SIZEOF_HSPTR SIZEOF_VOID_P+#define ALIGNMENT_HSPTR ALIGNOF_VOID_P++#define SIZEOF_HSFUNPTR SIZEOF_VOID_P+#define ALIGNMENT_HSFUNPTR ALIGNOF_VOID_P++#define SIZEOF_HSFOREIGNPTR SIZEOF_VOID_P+#define ALIGNMENT_HSFOREIGNPTR ALIGNOF_VOID_P++#define SIZEOF_HSSTABLEPTR SIZEOF_VOID_P+#define ALIGNMENT_HSSTABLEPTR ALIGNOF_VOID_P++#define SIZEOF_INT8 8+#define ALIGNMENT_INT8 ALIGNOF_UINT8_T++#define SIZEOF_WORD8 8+#define ALIGNMENT_WORD8 ALIGNOF_UINT8_T++#define SIZEOF_INT16 16+#define ALIGNMENT_INT16 ALIGNOF_UINT16_T++#define SIZEOF_WORD16 16+#define ALIGNMENT_WORD16 ALIGNOF_UINT16_T++#define SIZEOF_INT32 32+#define ALIGNMENT_INT32 ALIGNOF_UINT32_T++#define SIZEOF_WORD32 32+#define ALIGNMENT_WORD32 ALIGNOF_UINT32_T++#define SIZEOF_INT64 64+#define ALIGNMENT_INT64 ALIGNOF_UINT64_T++#define SIZEOF_WORD64 64+#define ALIGNMENT_WORD64 ALIGNOF_UINT64_T+++#endif
@@ -0,0 +1,147 @@+{- --------------------------------------------------------------------------+// Macros to help make various instances for tuples.+// A kind of poor mans deriving.+//+// --------------------------------------------------------------------------+-}++#define COMMA ,++{- --------------------------------------------------------------------------+// 2 tuple, 1 unary op+// --------------------------------------------------------------------------+-}+#define TUPLE2_UNOP1_INSTANCE(clscon,op1,op1preArg,op1postArg,op1subop,pre,sep,post) \+instance (clscon a, clscon b) => clscon (a,b) where \+ { op1 op1preArg (a,b) op1postArg \+ = pre \+ op1subop a \+ sep op1subop b \+ post \+ }++{- --------------------------------------------------------------------------+// 3 tuple, 1 unary op+// --------------------------------------------------------------------------+-}+#define TUPLE3_UNOP1_INSTANCE(clscon,op1,op1preArg,op1postArg,op1subop,pre,sep,post) \+instance (clscon a, clscon b, clscon c) => clscon (a,b,c) where \+ { op1 op1preArg (a,b,c) op1postArg \+ = pre \+ op1subop a \+ sep op1subop b \+ sep op1subop c \+ post \+ }++{- --------------------------------------------------------------------------+// 4 tuple, 1 unary op+// --------------------------------------------------------------------------+-}+#define TUPLE4_UNOP1_INSTANCE(clscon,op1,op1preArg,op1postArg,op1subop,pre,sep,post) \+instance (clscon a, clscon b, clscon c, clscon d) => clscon (a,b,c,d) where \+ { op1 op1preArg (a,b,c,d) op1postArg \+ = pre \+ op1subop a \+ sep op1subop b \+ sep op1subop c \+ sep op1subop d \+ post \+ }++{- --------------------------------------------------------------------------+// 5 tuple, 1 unary op+// --------------------------------------------------------------------------+-}+#define TUPLE5_UNOP1_INSTANCE(clscon,op1,op1preArg,op1postArg,op1subop,pre,sep,post) \+instance (clscon a, clscon b, clscon c, clscon d, clscon e) => clscon (a,b,c,d,e) where \+ { op1 op1preArg (a,b,c,d,e) op1postArg \+ = pre \+ op1subop a \+ sep op1subop b \+ sep op1subop c \+ sep op1subop d \+ sep op1subop e \+ post \+ }++{- --------------------------------------------------------------------------+// Set of 2..n tuple, 1 unary op+// --------------------------------------------------------------------------+-}+#define TUPLE_UNOP1_INSTANCES(clscon,op1,op1preArg,op1postArg,op1subop,pre,sep,post) \+{ TUPLE2_UNOP1_INSTANCE(clscon,op1,op1preArg,op1postArg,op1subop,pre,sep,post) ;\+ TUPLE3_UNOP1_INSTANCE(clscon,op1,op1preArg,op1postArg,op1subop,pre,sep,post) ;\+ TUPLE4_UNOP1_INSTANCE(clscon,op1,op1preArg,op1postArg,op1subop,pre,sep,post) ;\+ TUPLE5_UNOP1_INSTANCE(clscon,op1,op1preArg,op1postArg,op1subop,pre,sep,post) \+}++{- --------------------------------------------------------------------------+// 2 tuple, 1 binary op+// --------------------------------------------------------------------------+-}+#define TUPLE2_BINOP1_INSTANCE(clscon,op1,op1subop,pre,sep,post) \+instance (clscon a, clscon b) => clscon (a,b) where \+ { (a1,b1) op1 (a2,b2) \+ = pre \+ a1 op1subop a2 \+ sep b1 op1subop b2 \+ post \+ }++{- --------------------------------------------------------------------------+// 3 tuple, 1 binary op+// --------------------------------------------------------------------------+-}+#define TUPLE3_BINOP1_INSTANCE(clscon,op1,op1subop,pre,sep,post) \+instance (clscon a, clscon b, clscon c) => clscon (a,b,c) where \+ { (a1,b1,c1) op1 (a2,b2,c2) \+ = pre \+ a1 op1subop a2 \+ sep b1 op1subop b2 \+ sep c1 op1subop c2 \+ post \+ }++{- --------------------------------------------------------------------------+// 4 tuple, 1 binary op+// --------------------------------------------------------------------------+-}+#define TUPLE4_BINOP1_INSTANCE(clscon,op1,op1subop,pre,sep,post) \+instance (clscon a, clscon b, clscon c, clscon d) => clscon (a,b,c,d) where \+ { (a1,b1,c1,d1) op1 (a2,b2,c2,d2) \+ = pre \+ a1 op1subop a2 \+ sep b1 op1subop b2 \+ sep c1 op1subop c2 \+ sep d1 op1subop d2 \+ post \+ }++{- --------------------------------------------------------------------------+// 5 tuple, 1 binary op+// --------------------------------------------------------------------------+-}+#define TUPLE5_BINOP1_INSTANCE(clscon,op1,op1subop,pre,sep,post) \+instance (clscon a, clscon b, clscon c, clscon d, clscon e) => clscon (a,b,c,d,e) where \+ { (a1,b1,c1,d1,e1) op1 (a2,b2,c2,d2,e2) \+ = pre \+ a1 op1subop a2 \+ sep b1 op1subop b2 \+ sep c1 op1subop c2 \+ sep d1 op1subop d2 \+ sep e1 op1subop e2 \+ post \+ }++{- --------------------------------------------------------------------------+// Set of 2..n tuple, 1 binary op+// --------------------------------------------------------------------------+-}+#define TUPLE_BINOP1_INSTANCES(clscon,op1,op1subop,pre,sep,post) \+{ TUPLE2_BINOP1_INSTANCE(clscon,op1,op1subop,pre,sep,post) ;\+ TUPLE3_BINOP1_INSTANCE(clscon,op1,op1subop,pre,sep,post) ;\+ TUPLE4_BINOP1_INSTANCE(clscon,op1,op1subop,pre,sep,post) ;\+ TUPLE5_BINOP1_INSTANCE(clscon,op1,op1subop,pre,sep,post) \+}+
@@ -0,0 +1,149 @@+{- --------------------------------------------------------------------------+// Macros to help make Typeable instances.+//+// INSTANCE_TYPEABLEn(tc,tcname,"tc") defines+//+// instance Typeable/n/ tc+// instance Typeable a => Typeable/n-1/ (tc a)+// instance (Typeable a, Typeable b) => Typeable/n-2/ (tc a b)+// ...+// instance (Typeable a1, ..., Typeable an) => Typeable (tc a1 ... an)+// --------------------------------------------------------------------------+-}++#ifndef TYPEABLE_H+#define TYPEABLE_H++#define INSTANCE_TYPEABLE0(tycon,tcname,str) \+tcname :: TyCon; \+tcname = mkTyCon str; \+instance Typeable tycon where { typeOf _ = mkTyConApp tcname [] }++#ifdef __GLASGOW_HASKELL__++-- // For GHC, the extra instances follow from general instance declarations+-- // defined in Data.Typeable.++#define INSTANCE_TYPEABLE1(tycon,tcname,str) \+tcname :: TyCon; \+tcname = mkTyCon str; \+instance Typeable1 tycon where { typeOf1 _ = mkTyConApp tcname [] }++#define INSTANCE_TYPEABLE2(tycon,tcname,str) \+tcname :: TyCon; \+tcname = mkTyCon str; \+instance Typeable2 tycon where { typeOf2 _ = mkTyConApp tcname [] }++#define INSTANCE_TYPEABLE3(tycon,tcname,str) \+tcname :: TyCon; \+tcname = mkTyCon str; \+instance Typeable3 tycon where { typeOf3 _ = mkTyConApp tcname [] }++#define INSTANCE_TYPEABLE4(tycon,tcname,str) \+tcname :: TyCon; \+tcname = mkTyCon str; \+instance Typeable4 tycon where { typeOf4 _ = mkTyConApp tcname [] }++#define INSTANCE_TYPEABLE5(tycon,tcname,str) \+tcname :: TyCon; \+tcname = mkTyCon str; \+instance Typeable5 tycon where { typeOf5 _ = mkTyConApp tcname [] }++#define INSTANCE_TYPEABLE6(tycon,tcname,str) \+tcname :: TyCon; \+tcname = mkTyCon str; \+instance Typeable6 tycon where { typeOf6 _ = mkTyConApp tcname [] }++#define INSTANCE_TYPEABLE7(tycon,tcname,str) \+tcname :: TyCon; \+tcname = mkTyCon str; \+instance Typeable7 tycon where { typeOf7 _ = mkTyConApp tcname [] }++#else /* !__GLASGOW_HASKELL__ */++#define INSTANCE_TYPEABLE1(tycon,tcname,str) \+tcname = mkTyCon str; \+instance Typeable1 tycon where { typeOf1 _ = mkTyConApp tcname [] }; \+instance Typeable a => Typeable (tycon a) where { typeOf = typeOfDefault }++#define INSTANCE_TYPEABLE2(tycon,tcname,str) \+tcname = mkTyCon str; \+instance Typeable2 tycon where { typeOf2 _ = mkTyConApp tcname [] }; \+instance Typeable a => Typeable1 (tycon a) where { \+ typeOf1 = typeOf1Default }; \+instance (Typeable a, Typeable b) => Typeable (tycon a b) where { \+ typeOf = typeOfDefault }++#define INSTANCE_TYPEABLE3(tycon,tcname,str) \+tcname = mkTyCon str; \+instance Typeable3 tycon where { typeOf3 _ = mkTyConApp tcname [] }; \+instance Typeable a => Typeable2 (tycon a) where { \+ typeOf2 = typeOf2Default }; \+instance (Typeable a, Typeable b) => Typeable1 (tycon a b) where { \+ typeOf1 = typeOf1Default }; \+instance (Typeable a, Typeable b, Typeable c) => Typeable (tycon a b c) where { \+ typeOf = typeOfDefault }++#define INSTANCE_TYPEABLE4(tycon,tcname,str) \+tcname = mkTyCon str; \+instance Typeable4 tycon where { typeOf4 _ = mkTyConApp tcname [] }; \+instance Typeable a => Typeable3 (tycon a) where { \+ typeOf3 = typeOf3Default }; \+instance (Typeable a, Typeable b) => Typeable2 (tycon a b) where { \+ typeOf2 = typeOf2Default }; \+instance (Typeable a, Typeable b, Typeable c) => Typeable1 (tycon a b c) where { \+ typeOf1 = typeOf1Default }; \+instance (Typeable a, Typeable b, Typeable c, Typeable d) => Typeable (tycon a b c d) where { \+ typeOf = typeOfDefault }++#define INSTANCE_TYPEABLE5(tycon,tcname,str) \+tcname = mkTyCon str; \+instance Typeable5 tycon where { typeOf5 _ = mkTyConApp tcname [] }; \+instance Typeable a => Typeable4 (tycon a) where { \+ typeOf4 = typeOf4Default }; \+instance (Typeable a, Typeable b) => Typeable3 (tycon a b) where { \+ typeOf3 = typeOf3Default }; \+instance (Typeable a, Typeable b, Typeable c) => Typeable2 (tycon a b c) where { \+ typeOf2 = typeOf2Default }; \+instance (Typeable a, Typeable b, Typeable c, Typeable d) => Typeable1 (tycon a b c d) where { \+ typeOf1 = typeOf1Default }; \+instance (Typeable a, Typeable b, Typeable c, Typeable d, Typeable e) => Typeable (tycon a b c d e) where { \+ typeOf = typeOfDefault }++#define INSTANCE_TYPEABLE6(tycon,tcname,str) \+tcname = mkTyCon str; \+instance Typeable6 tycon where { typeOf6 _ = mkTyConApp tcname [] }; \+instance Typeable a => Typeable5 (tycon a) where { \+ typeOf5 = typeOf5Default }; \+instance (Typeable a, Typeable b) => Typeable4 (tycon a b) where { \+ typeOf4 = typeOf4Default }; \+instance (Typeable a, Typeable b, Typeable c) => Typeable3 (tycon a b c) where { \+ typeOf3 = typeOf3Default }; \+instance (Typeable a, Typeable b, Typeable c, Typeable d) => Typeable2 (tycon a b c d) where { \+ typeOf2 = typeOf2Default }; \+instance (Typeable a, Typeable b, Typeable c, Typeable d, Typeable e) => Typeable1 (tycon a b c d e) where { \+ typeOf1 = typeOf1Default }; \+instance (Typeable a, Typeable b, Typeable c, Typeable d, Typeable e, Typeable f) => Typeable (tycon a b c d e f) where { \+ typeOf = typeOfDefault }++#define INSTANCE_TYPEABLE7(tycon,tcname,str) \+tcname = mkTyCon str; \+instance Typeable7 tycon where { typeOf7 _ = mkTyConApp tcname [] }; \+instance Typeable a => Typeable6 (tycon a) where { \+ typeOf6 = typeOf6Default }; \+instance (Typeable a, Typeable b) => Typeable5 (tycon a b) where { \+ typeOf5 = typeOf5Default }; \+instance (Typeable a, Typeable b, Typeable c) => Typeable4 (tycon a b c) where { \+ typeOf4 = typeOf4Default }; \+instance (Typeable a, Typeable b, Typeable c, Typeable d) => Typeable3 (tycon a b c d) where { \+ typeOf3 = typeOf3Default }; \+instance (Typeable a, Typeable b, Typeable c, Typeable d, Typeable e) => Typeable2 (tycon a b c d e) where { \+ typeOf2 = typeOf2Default }; \+instance (Typeable a, Typeable b, Typeable c, Typeable d, Typeable e, Typeable f) => Typeable1 (tycon a b c d e f) where { \+ typeOf1 = typeOf1Default }; \+instance (Typeable a, Typeable b, Typeable c, Typeable d, Typeable e, Typeable f, Typeable g) => Typeable (tycon a b c d e f g) where { \+ typeOf = typeOfDefault }++#endif /* !__GLASGOW_HASKELL__ */++#endif
@@ -0,0 +1,11 @@+/* + * (c) The University of Glasgow 2002+ *+ * Directory Runtime Support+ */+#ifndef __DIRUTILS_H__+#define __DIRUTILS_H__++extern int __hscore_readdir(DIR *dirPtr, struct dirent **pDirEnt);++#endif /* __DIRUTILS_H__ */
@@ -0,0 +1,2 @@+exposed-modules: Control.Monad Data.Bits Data.Char Data.Either Data.Int Data.IORef Data.List Data.Maybe Data.Typeable Data.Word Debug.Trace Foreign.C.Error Foreign.C.String Foreign.C.Types Foreign.C Foreign.ForeignPtr Foreign.Marshal.Alloc Foreign.Marshal.Array Foreign.Marshal.Error Foreign.Marshal.Pool Foreign.Marshal.Utils Foreign.Marshal Foreign.Ptr Foreign.StablePtr Foreign.Storable Foreign System.IO.Error System.IO.Fix System.IO.Unsafe System.IO System.Posix.Internals System.Posix.Types UHC.Array UHC.Base UHC.Bits UHC.Bounded UHC.BoxArray UHC.ByteArray UHC.Char UHC.Conc UHC.Enum UHC.Eq UHC.Float UHC.ForeignPtr UHC.GC UHC.Generics.Tuple UHC.Generics UHC.Handle UHC.Int UHC.IO UHC.IOBase UHC.Ix UHC.LazyST UHC.MutVar UHC.MVar UHC.OldException UHC.OldIO UHC.Ord UHC.Prims UHC.Ptr UHC.Read UHC.Real UHC.Run UHC.Show UHC.ST UHC.StablePtr UHC.StackTrace UHC.Storable UHC.STRef UHC.Types UHC.Weak UHC.WeakPtr UHC.Word Unsafe.Coerce+build-depends:
@@ -1,8 +1,13 @@ # Changelog +## 1.1.8.7 - 20150219++- [compiler driver] Refactoring: top level compiler driver functions now are typed as monad transformer, requiring adapted uhc-utils>=0.1.5.0.+- [corerun] More primitives implemented.+ ## 1.1.8.6 -- +- [build] fix for uhc-light-1.1.8.5 package build failure. ## 1.1.8.5
@@ -27,12 +27,13 @@ opts = maybe opts0 id o case ehcOptImmQuit opts of- Just immq -> handleImmQuitOption ehcrunCmdLineOpts ["rcr", "cr"] immq opts+ Just immq -> handleImmQuitOption ehcrunCmdLineOpts ["rcr", "crr", "cr"] immq opts _ -> case (n,errs) of ([fname], []) -> do let (bname,ext) = splitExtension fname case ext of ".rcr" -> runRCR opts fname+ ".crr" -> runRCR opts fname ".cr" -> mainEHC $ opts { ehcOptMbTarget = JustOk Target_None_Core_AsIs , ehcOptCoreOpts = CoreOpt_Run : ehcOptCoreOpts opts
@@ -6,12 +6,14 @@ , defaultTargetFlavor , allTargetFlavorMp, showAllTargetFlavors', showAllTargetFlavors , targetDoesHPTAnalysis+, targetIsViaGrin , targetIsGrinBytecode , targetAllowsGrinNodePtrMix , targetIsC , targetAllowsOLinking , targetAllowsJarLinking-, targetIsCore+, targetIsCoreVariation+, targetIsCoreRun , targetIsTyCore , targetIsJVM , targetIsViaGrinCmmJavaScript@@ -37,6 +39,7 @@ data Target = Target_None -- no codegen | Target_None_Core_AsIs -- only Core+ | Target_None_Core_CoreRun -- CoreRun via Core | Target_None_TyCore_None -- only TyCore -- jazy@@ -62,10 +65,11 @@ | Target_FullProgAnal_Grin_CLR -- full program analysis on grin, generating for Common Language Runtime (.NET / Mono) deriving ( Eq, Ord, Enum ) -{-# LINE 118 "src/ehc/Base/Target.chs" #-}+{-# LINE 119 "src/ehc/Base/Target.chs" #-} instance Show Target where show Target_None = "NONE" show Target_None_Core_AsIs = "cr"+ show Target_None_Core_CoreRun = "crr" show Target_None_TyCore_None = "tycore" show Target_Interpreter_Core_Jazy = "jazy" show Target_Interpreter_Core_JavaScript = "js"@@ -76,11 +80,11 @@ show Target_Interpreter_Grin_C = "bc" show Target_FullProgAnal_Grin_CLR = "clr" -{-# LINE 140 "src/ehc/Base/Target.chs" #-}+{-# LINE 142 "src/ehc/Base/Target.chs" #-} defaultTarget :: Target defaultTarget = Target_None_Core_AsIs -{-# LINE 153 "src/ehc/Base/Target.chs" #-}+{-# LINE 155 "src/ehc/Base/Target.chs" #-} supportedTargetMp :: Map.Map String Target (supportedTargetMp,allTargetInfoMp) = (Map.fromList ts, Map.fromList is)@@ -89,6 +93,7 @@ | (t,i) <- [] ++ [ mk Target_None_Core_AsIs [] ]+ -- ++ [ mk Target_None_Core_CoreRun [] ] ] mk t ffis = (t,TargetInfo (FFIWay_Prim : ffis)) @@ -100,23 +105,23 @@ showSupportedTargets = showSupportedTargets' " " -{-# LINE 206 "src/ehc/Base/Target.chs" #-}+{-# LINE 211 "src/ehc/Base/Target.chs" #-} data TargetFlavor = TargetFlavor_Plain -- no special stuff | TargetFlavor_Debug -- debugging variant -- more: profiling, .... deriving (Eq,Ord,Enum) -{-# LINE 214 "src/ehc/Base/Target.chs" #-}+{-# LINE 219 "src/ehc/Base/Target.chs" #-} defaultTargetFlavor :: TargetFlavor defaultTargetFlavor = TargetFlavor_Plain -{-# LINE 219 "src/ehc/Base/Target.chs" #-}+{-# LINE 224 "src/ehc/Base/Target.chs" #-} instance Show TargetFlavor where show TargetFlavor_Plain = "plain" show TargetFlavor_Debug = "debug" -{-# LINE 227 "src/ehc/Base/Target.chs" #-}+{-# LINE 232 "src/ehc/Base/Target.chs" #-} allTargetFlavorMp :: Map.Map String TargetFlavor allTargetFlavorMp = Map.fromList ts@@ -136,56 +141,73 @@ showAllTargetFlavors = showAllTargetFlavors' " " -{-# LINE 252 "src/ehc/Base/Target.chs" #-}+{-# LINE 257 "src/ehc/Base/Target.chs" #-} targetDoesHPTAnalysis :: Target -> Bool targetDoesHPTAnalysis t = case t of _ -> False -{-# LINE 293 "src/ehc/Base/Target.chs" #-}+{-# LINE 286 "src/ehc/Base/Target.chs" #-}+targetIsViaGrin :: Target -> Bool+targetIsViaGrin t+ = case t of+ _ -> False+{-# INLINE targetIsViaGrin #-}++{-# LINE 298 "src/ehc/Base/Target.chs" #-} targetIsGrinBytecode :: Target -> Bool targetIsGrinBytecode t = case t of _ -> False {-# INLINE targetIsGrinBytecode #-} -{-# LINE 304 "src/ehc/Base/Target.chs" #-}+{-# LINE 309 "src/ehc/Base/Target.chs" #-} targetAllowsGrinNodePtrMix :: Target -> Bool targetAllowsGrinNodePtrMix t = case t of _ -> False {-# INLINE targetAllowsGrinNodePtrMix #-} -{-# LINE 316 "src/ehc/Base/Target.chs" #-}+{-# LINE 321 "src/ehc/Base/Target.chs" #-} targetIsC :: Target -> Bool targetIsC t = case t of _ -> False {-# INLINE targetIsC #-} -{-# LINE 330 "src/ehc/Base/Target.chs" #-}+{-# LINE 335 "src/ehc/Base/Target.chs" #-} targetAllowsOLinking :: Target -> Bool targetAllowsOLinking t = case t of _ -> False {-# INLINE targetAllowsOLinking #-} -{-# LINE 341 "src/ehc/Base/Target.chs" #-}+{-# LINE 346 "src/ehc/Base/Target.chs" #-} targetAllowsJarLinking :: Target -> Bool targetAllowsJarLinking t = case t of _ -> False {-# INLINE targetAllowsJarLinking #-} -{-# LINE 352 "src/ehc/Base/Target.chs" #-}-targetIsCore :: Target -> Bool-targetIsCore t+{-# LINE 357 "src/ehc/Base/Target.chs" #-}+-- | Is a variation of direct Core running, without further platform dependent translation+targetIsCoreVariation :: Target -> Bool+targetIsCoreVariation t = case t of Target_None_Core_AsIs -> True+ Target_None_Core_CoreRun -> True _ -> False-{-# INLINE targetIsCore #-}+{-# INLINE targetIsCoreVariation #-} -{-# LINE 361 "src/ehc/Base/Target.chs" #-}+{-# LINE 370 "src/ehc/Base/Target.chs" #-}+-- | Is CoreRun target+targetIsCoreRun :: Target -> Bool+targetIsCoreRun t+ = case t of+ Target_None_Core_CoreRun -> True+ _ -> False++{-# LINE 381 "src/ehc/Base/Target.chs" #-} targetIsTyCore :: Target -> Bool targetIsTyCore t = case t of@@ -193,42 +215,42 @@ _ -> False {-# INLINE targetIsTyCore #-} -{-# LINE 370 "src/ehc/Base/Target.chs" #-}+{-# LINE 390 "src/ehc/Base/Target.chs" #-} targetIsJVM :: Target -> Bool targetIsJVM t = case t of _ -> False {-# INLINE targetIsJVM #-} -{-# LINE 381 "src/ehc/Base/Target.chs" #-}+{-# LINE 401 "src/ehc/Base/Target.chs" #-} targetIsViaGrinCmmJavaScript :: Target -> Bool targetIsViaGrinCmmJavaScript t = case t of _ -> False {-# INLINE targetIsViaGrinCmmJavaScript #-} -{-# LINE 392 "src/ehc/Base/Target.chs" #-}+{-# LINE 412 "src/ehc/Base/Target.chs" #-} targetIsViaCoreJavaScript :: Target -> Bool targetIsViaCoreJavaScript t = case t of _ -> False {-# INLINE targetIsViaCoreJavaScript #-} -{-# LINE 403 "src/ehc/Base/Target.chs" #-}+{-# LINE 423 "src/ehc/Base/Target.chs" #-} targetIsJavaScript :: Target -> Bool targetIsJavaScript t = case t of _ -> False {-# INLINE targetIsJavaScript #-} -{-# LINE 437 "src/ehc/Base/Target.chs" #-}+{-# LINE 457 "src/ehc/Base/Target.chs" #-} -- | target runs on (possibly emulated) UNIX / C environment? this should coincide with flag EHC_CFG_USE_UNIX_AND_C in src/ehc/variant.mk targetIsOnUnixAndOrC :: Target -> Bool targetIsOnUnixAndOrC t = targetIsC t || targetIsJVM t {-# INLINE targetIsOnUnixAndOrC #-} -{-# LINE 449 "src/ehc/Base/Target.chs" #-}+{-# LINE 469 "src/ehc/Base/Target.chs" #-} data FFIWay = FFIWay_Prim -- as primitive | FFIWay_CCall -- as C call@@ -243,13 +265,13 @@ instance PP FFIWay where pp = pp . show -{-# LINE 479 "src/ehc/Base/Target.chs" #-}+{-# LINE 499 "src/ehc/Base/Target.chs" #-} ffiWayForPrim :: Target -> Maybe FFIWay ffiWayForPrim t | targetIsC t = Just FFIWay_CCall | otherwise = Nothing -{-# LINE 507 "src/ehc/Base/Target.chs" #-}+{-# LINE 527 "src/ehc/Base/Target.chs" #-} data TargetInfo = TargetInfo { targiAllowedFFI :: [FFIWay]@@ -257,7 +279,7 @@ type TargInfoMp = Map.Map Target TargetInfo -{-# LINE 516 "src/ehc/Base/Target.chs" #-}+{-# LINE 536 "src/ehc/Base/Target.chs" #-} allTargetInfoMp :: TargInfoMp -- | All allowed platform dependent ways to do a FFI call, a primitive 'FFIWay_Prim' is always allowed even though there might be no backend for it.@@ -265,7 +287,7 @@ allFFIWays :: [FFIWay] allFFIWays = nub $ (FFIWay_Prim :) $ concatMap targiAllowedFFI $ Map.elems allTargetInfoMp -{-# LINE 529 "src/ehc/Base/Target.chs" #-}+{-# LINE 549 "src/ehc/Base/Target.chs" #-} deriving instance Typeable Target deriving instance Data Target @@ -275,7 +297,7 @@ deriving instance Typeable TargetFlavor deriving instance Data TargetFlavor -{-# LINE 544 "src/ehc/Base/Target.chs" #-}+{-# LINE 564 "src/ehc/Base/Target.chs" #-} instance Binary Target where put = putEnum8 get = getEnum8
@@ -15,6 +15,7 @@ , ehcGccOptsStatic, ehcGccOptsStatic' , libnamesGccEhcExtraExternalLibs , mbSuffixExec, linkerSymbolPrefix+, suffixDotlessBinaryCoreRun, suffixDotlessInputOutputBinaryCoreRun, suffixDotlessOutputTextualCoreRun, suffixDotlessInputOutputTextualCoreRun , suffixDotlessBinaryCore, suffixDotlessInputOutputBinaryCore, suffixDotlessOutputTextualCore, suffixDotlessInputOutputTextualCore , suffixDotlessInputOutputCoreRun , mkInstallPkgdirSystem@@ -64,12 +65,12 @@ , verMajor = "1" , verMinor = "1" , verMinorMinor = "8"- , verMinorMinorMinor = "6"+ , verMinorMinorMinor = "7" , verQuality = "alpha" , verShort = "1.1" , verMedium = "1.1.8"- , verFull = "1.1.8.6"- , verAsNumber = "1186"+ , verFull = "1.1.8.7"+ , verAsNumber = "1187" , verProg = "ehc" } @@ -212,6 +213,23 @@ {-# LINE 307 "src/ehc/Config.chs" #-}+-- | Suffix (dotless) for binary corerun files, to be read in as part of the compilation process+suffixDotlessBinaryCoreRun :: String+suffixDotlessBinaryCoreRun = "crr"++-- | Suffix (dotless) for binary dumped/output corerun files+suffixDotlessInputOutputBinaryCoreRun :: String+suffixDotlessInputOutputBinaryCoreRun = "bcrr"++-- | Suffix (dotless) for textually dumped/output corerun files+suffixDotlessOutputTextualCoreRun :: String+suffixDotlessOutputTextualCoreRun = "tcrr"++-- | Suffix (dotless) for textually read corerun files+suffixDotlessInputOutputTextualCoreRun :: String+suffixDotlessInputOutputTextualCoreRun = suffixDotlessOutputTextualCoreRun++{-# LINE 325 "src/ehc/Config.chs" #-} -- | Suffix (dotless) for binary core files, to be read in as part of the compilation process suffixDotlessBinaryCore :: String suffixDotlessBinaryCore = "cr"@@ -229,7 +247,7 @@ suffixDotlessInputOutputTextualCore = suffixDotlessOutputTextualCore -{-# LINE 326 "src/ehc/Config.chs" #-}+{-# LINE 344 "src/ehc/Config.chs" #-} -- | Suffix (dotless) for CoreRun files suffixDotlessInputOutputCoreRun :: String suffixDotlessInputOutputCoreRun = "rcr"
@@ -11,7 +11,7 @@ cppOpts = fst $ parseCmdLineOpts Cmd_CPP "-Wno-invalid-pp-token" -- cppOpts = showCmdLineOpts cppOpts' -ehcSvnRevision = "master@c9470bb95d"+ehcSvnRevision = "master@a0c9378a77" ehcDefaultInplaceInstallDir = "/Volumes/Work/Programming/uhc/EHC/install"
@@ -1,22 +1,33 @@ module UHC.Light.Compiler.ConfigInternalVersions-( InternalVersionHI, InternalVersionCore-, internalVersionHI, internalVersionCore )+( InternalVersionCombined+, internalVersionCombined+, internalVersionHI, internalVersionCore, internalVersionCoreRun ) where+import Data.Word+import Data.Bits -{-# LINE 13 "src/ehc/ConfigInternalVersions.chs" #-}+{-# LINE 16 "src/ehc/ConfigInternalVersions.chs" #-} -- | Encoding of internal version-type InternalVersion = Int--type InternalVersionHI = InternalVersion-type InternalVersionCore = InternalVersion+type InternalVersion = Word64+type InternalVersionCombined = Word64 mkInternalVersion :: Int -> InternalVersion-mkInternalVersion = id+mkInternalVersion = fromIntegral -{-# LINE 24 "src/ehc/ConfigInternalVersions.chs" #-}+{-# LINE 25 "src/ehc/ConfigInternalVersions.chs" #-}+internalVersionCombined :: InternalVersionCombined+internalVersionCombined =+ internalVersionHI+ .|. (internalVersionCore `shiftL` 8)+ .|. (internalVersionCoreRun `shiftL` 16)++{-# LINE 33 "src/ehc/ConfigInternalVersions.chs" #-} -- | For binary/serialized HI .hi files and all data stored there internalVersionHI = mkInternalVersion 1 --- | For binary/serialized Core .cr/.bcr etc files+-- | For binary/serialized Core .cr/.bcr/.tcr etc files internalVersionCore = mkInternalVersion 14++-- | For binary/serialized CoreRun .crr/.bcrr./tcrr etc files+internalVersionCoreRun = mkInternalVersion 6
@@ -1,5734 +1,5962 @@ -- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/ToCoreRun)-module UHC.Light.Compiler.Core.ToCoreRun(cmod2CoreRun', cmod2CoreRunWithModNr, cmod2CoreRun) where--import UHC.Light.Compiler.Base.Common-import UHC.Light.Compiler.Base.TermLike-import UHC.Light.Compiler.Opts-import UHC.Light.Compiler.Ty-import UHC.Light.Compiler.Core-import Data.Maybe-import qualified Data.Map as Map-import Data.Char-import UHC.Util.Utils-import qualified UHC.Util.FastSeq as Seq-import UHC.Light.Compiler.Base.HsName.Builtin-import UHC.Light.Compiler.CodeGen.BuiltinSizeInfo-import UHC.Light.Compiler.CodeGen.BuiltinPrims-import UHC.Light.Compiler.CodeGen.BasicAnnot-import qualified UHC.Light.Compiler.CoreRun as CR-import qualified UHC.Light.Compiler.CoreRun.API as CR-import qualified UHC.Light.Compiler.CoreRun.Prim as CR-import UHC.Light.Compiler.Foreign.Extract--------------------cmod2CoreRun'- :: EHCOpts- -> Int -- sequence nr of module (offset), used to create global per module references- -> CR.Nm2RefMp -- outer bindings- -> CModule- -> ( CR.Mod -- generated CoreRun- , CR.Nm2RefMp -- name to ref mapping of toplevel bindings- )-cmod2CoreRun' opts modNr nm2ref cmod- = ( crm_Syn_CodeAGItf t- , nm2refGath_Syn_CodeAGItf t- )- where t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf cmod))- (Inh_CodeAGItf- { modNr_Inh_CodeAGItf = modNr- , opts_Inh_CodeAGItf = opts- , nm2ref_Inh_CodeAGItf = nm2ref- })--cmod2CoreRunWithModNr :: Int -> CModule -> CR.Mod-cmod2CoreRunWithModNr nr m = m'- where (m',_) = cmod2CoreRun' defaultEHCOpts nr Map.empty m--cmod2CoreRun :: CModule -> CR.Mod-cmod2CoreRun = cmod2CoreRunWithModNr 0------ | What to do with binding in terms of thunking/forcing?-data ToBe- = ToBe_Thunked- | ToBe_Forced- | ToBe_LeftAsIs- deriving Eq------ | Tail context-data TailCtx- = TailCtx_Plain- | TailCtx_TailCall- | TailCtx_CaseAlt--tailCtxIsTailRec :: TailCtx -> Bool-tailCtxIsTailRec TailCtx_TailCall = True-tailCtxIsTailRec _ = False---- | Wrap according to tail context-cseCtxWrap :: TailCtx -> CR.Exp -> CR.Exp-cseCtxWrap TailCtx_TailCall = CR.mkTail-cseCtxWrap _ = id------ | Construct application-mkApp :: CR.Exp -> CR.CRArray CR.SExp -> CR.Exp-mkApp f as = CR.mkApp' (CR.mkEval f) as------ | Wrap context saving if not at tail recursive position-tailrec :: TailCtx -> CR.Exp -> CR.Exp-tailrec tailCtx = if tailCtxIsTailRec tailCtx then id else id -- CR.Exp_Ret -- id---- | Wrap forcing if at tail recursive position-taileval :: TailCtx -> CR.Exp -> CR.Exp-taileval tailCtx = if tailCtxIsTailRec tailCtx then CR.mkEval else id---- CAlt ---------------------------------------------------------{-- visit 0:- chained attribute:- refOffset : Int- visit 1:- inherited attributes:- evalCtx : EvalCtx- lev : Int- modNr : Int- nm2ref : CR.Nm2RefMp- opts : EHCOpts- scrutRef : CR.RRef- tailCtx : TailCtx- chained attribute:- stackDepth : Int- synthesized attributes:- cra : [CR.Alt]- refOffsetMax : Int- stackDepthMax : Int- alternatives:- alternative Alt:- child pat : CPat - child expr : CExpr - visit 1:- local whatAbove : {WhatExpr}- local nm2refNew : _--}--- cata-sem_CAlt :: CAlt ->- T_CAlt-sem_CAlt (CAlt_Alt _pat _expr) =- (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr))--- semantic domain-type T_CAlt = Int ->- ( Int,T_CAlt_1)-type T_CAlt_1 = EvalCtx ->- Int ->- Int ->- (CR.Nm2RefMp) ->- EHCOpts ->- (CR.RRef) ->- Int ->- TailCtx ->- ( ([CR.Alt]),Int,Int,Int)-sem_CAlt_Alt :: T_CPat ->- T_CExpr ->- T_CAlt-sem_CAlt_Alt pat_ expr_ =- (\ _lhsIrefOffset ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CAlt_Alt_1 :: T_CAlt_1- sem_CAlt_Alt_1 =- (\ _lhsIevalCtx- _lhsIlev- _lhsImodNr- _lhsInm2ref- _lhsIopts- _lhsIscrutRef- _lhsIstackDepth- _lhsItailCtx ->- (case (ExprIsOther) of- { _whatAbove ->- (case (_whatAbove) of- { _exprOwhatAbove ->- (case (_lhsItailCtx) of- { _exprOtailCtx ->- (case (_lhsImodNr) of- { _exprOmodNr ->- (case (_lhsIlev) of- { _exprOlev ->- (case (_lhsIstackDepth) of- { _patOstackDepth ->- (case (_lhsIrefOffset) of- { _patOrefOffset ->- (case (_lhsIopts) of- { _patOopts ->- (case (_lhsInm2ref) of- { _patOnm2ref ->- (case (_lhsImodNr) of- { _patOmodNr ->- (case (_lhsIlev) of- { _patOlev ->- (case (pat_ _patOlev _patOmodNr _patOnm2ref _patOopts _patOrefOffset _patOstackDepth) of- { ( _patIcrp,_patIfldNmL,_patIrefOffset,_patIstackDepth) ->- (case (Map.fromList [ (n, CR.RRef_Fld _lhsIscrutRef i) | (n,i) <- zip _patIfldNmL [0..] ]) of- { _nm2refNew ->- (case (_nm2refNew `Map.union` _lhsInm2ref) of- { _exprOnm2ref ->- (case (_lhsIstackDepth) of- { _exprOstackDepth ->- (case (_lhsIrefOffset) of- { _exprOrefOffset ->- (case (expr_) of- { ( _exprIwhatBelow,expr_1) ->- (case (expr_1 _exprOlev _exprOmodNr _exprOrefOffset _exprOwhatAbove) of- { ( _exprInm2refGath,_exprIrefOffset,expr_2) ->- (case (_lhsIopts) of- { _exprOopts ->- (case (_lhsIevalCtx) of- { _exprOevalCtx ->- (case (True) of- { _exprOisTopTup ->- (case (True) of- { _exprOisTopApp ->- (case (expr_2 _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of- { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax,_exprIvref) ->- (case ([CR.Alt_Alt (CR.nm2RefMpInverse _nm2refNew) _exprIcre]) of- { _lhsOcra ->- (case (max _exprIrefOffset _exprIrefOffsetMax) of- { _lhsOrefOffsetMax ->- (case (_lhsIstackDepth) of- { _lhsOstackDepth ->- (case (max _exprIstackDepth _exprIstackDepthMax) of- { _lhsOstackDepthMax ->- ( _lhsOcra,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CAlt_Alt_1)) of- { ( sem_CAlt_1) ->- ( _lhsOrefOffset,sem_CAlt_1) }) }))--- CAltL --------------------------------------------------------{-- visit 0:- chained attribute:- refOffset : Int- visit 1:- inherited attributes:- evalCtx : EvalCtx- lev : Int- modNr : Int- nm2ref : CR.Nm2RefMp- opts : EHCOpts- scrutRef : CR.RRef- tailCtx : TailCtx- chained attribute:- stackDepth : Int- synthesized attributes:- cra : [CR.Alt]- refOffsetMax : Int- stackDepthMax : Int- alternatives:- alternative Cons:- child hd : CAlt - child tl : CAltL - alternative Nil:--}--- cata-sem_CAltL :: CAltL ->- T_CAltL-sem_CAltL list =- (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list))--- semantic domain-type T_CAltL = Int ->- ( Int,T_CAltL_1)-type T_CAltL_1 = EvalCtx ->- Int ->- Int ->- (CR.Nm2RefMp) ->- EHCOpts ->- (CR.RRef) ->- Int ->- TailCtx ->- ( ([CR.Alt]),Int,Int,Int)-sem_CAltL_Cons :: T_CAlt ->- T_CAltL ->- T_CAltL-sem_CAltL_Cons hd_ tl_ =- (\ _lhsIrefOffset ->- (case (_lhsIrefOffset) of- { _hdOrefOffset ->- (case (hd_ _hdOrefOffset) of- { ( _hdIrefOffset,hd_1) ->- (case (_hdIrefOffset) of- { _tlOrefOffset ->- (case (tl_ _tlOrefOffset) of- { ( _tlIrefOffset,tl_1) ->- (case (_tlIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CAltL_Cons_1 :: T_CAltL_1- sem_CAltL_Cons_1 =- (\ _lhsIevalCtx- _lhsIlev- _lhsImodNr- _lhsInm2ref- _lhsIopts- _lhsIscrutRef- _lhsIstackDepth- _lhsItailCtx ->- (case (_lhsItailCtx) of- { _tlOtailCtx ->- (case (_lhsIstackDepth) of- { _hdOstackDepth ->- (case (_lhsItailCtx) of- { _hdOtailCtx ->- (case (_lhsIscrutRef) of- { _hdOscrutRef ->- (case (_lhsIopts) of- { _hdOopts ->- (case (_lhsInm2ref) of- { _hdOnm2ref ->- (case (_lhsImodNr) of- { _hdOmodNr ->- (case (_lhsIlev) of- { _hdOlev ->- (case (_lhsIevalCtx) of- { _hdOevalCtx ->- (case (hd_1 _hdOevalCtx _hdOlev _hdOmodNr _hdOnm2ref _hdOopts _hdOscrutRef _hdOstackDepth _hdOtailCtx) of- { ( _hdIcra,_hdIrefOffsetMax,_hdIstackDepth,_hdIstackDepthMax) ->- (case (_hdIstackDepth) of- { _tlOstackDepth ->- (case (_lhsIscrutRef) of- { _tlOscrutRef ->- (case (_lhsInm2ref) of- { _tlOnm2ref ->- (case (_lhsImodNr) of- { _tlOmodNr ->- (case (_lhsIlev) of- { _tlOlev ->- (case (_lhsIopts) of- { _tlOopts ->- (case (_lhsIevalCtx) of- { _tlOevalCtx ->- (case (tl_1 _tlOevalCtx _tlOlev _tlOmodNr _tlOnm2ref _tlOopts _tlOscrutRef _tlOstackDepth _tlOtailCtx) of- { ( _tlIcra,_tlIrefOffsetMax,_tlIstackDepth,_tlIstackDepthMax) ->- (case (_hdIcra ++ _tlIcra) of- { _lhsOcra ->- (case (_hdIrefOffsetMax `max` _tlIrefOffsetMax) of- { _lhsOrefOffsetMax ->- (case (_tlIstackDepth) of- { _lhsOstackDepth ->- (case (_hdIstackDepthMax `max` _tlIstackDepthMax) of- { _lhsOstackDepthMax ->- ( _lhsOcra,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CAltL_Cons_1)) of- { ( sem_CAltL_1) ->- ( _lhsOrefOffset,sem_CAltL_1) }) }) }) }) }) }))-sem_CAltL_Nil :: T_CAltL-sem_CAltL_Nil =- (\ _lhsIrefOffset ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CAltL_Nil_1 :: T_CAltL_1- sem_CAltL_Nil_1 =- (\ _lhsIevalCtx- _lhsIlev- _lhsImodNr- _lhsInm2ref- _lhsIopts- _lhsIscrutRef- _lhsIstackDepth- _lhsItailCtx ->- (case ([]) of- { _lhsOcra ->- (case (0) of- { _lhsOrefOffsetMax ->- (case (_lhsIstackDepth) of- { _lhsOstackDepth ->- (case (0) of- { _lhsOstackDepthMax ->- ( _lhsOcra,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }))- in sem_CAltL_Nil_1)) of- { ( sem_CAltL_1) ->- ( _lhsOrefOffset,sem_CAltL_1) }) }))--- CBind --------------------------------------------------------{-- visit 0:- inherited attributes:- isGlobal : Bool- lev : Int- modNr : Int- chained attribute:- refOffset : Int- synthesized attributes:- nm : HsName- nm2refGath : CR.Nm2RefMp- visit 1:- inherited attributes:- evalCtx : EvalCtx- letBindingsCateg : CBindCateg- nm2ref : CR.Nm2RefMp- opts : EHCOpts- chained attribute:- stackDepth : Int- synthesized attributes:- crb : [(HsName, CR.Bind)]- refOffsetMax : Int- stackDepthMax : Int- alternatives:- alternative Bind:- child nm : {HsName}- child bindAspects : CBoundL - visit 0:- local ref : _- local nm2refGath : _- local refOffsetHere : _- visit 1:- local crb : _--}--- cata-sem_CBind :: CBind ->- T_CBind-sem_CBind (CBind_Bind _nm _bindAspects) =- (sem_CBind_Bind _nm (sem_CBoundL _bindAspects))--- semantic domain-type T_CBind = Bool ->- Int ->- Int ->- Int ->- ( HsName,(CR.Nm2RefMp),Int,T_CBind_1)-type T_CBind_1 = EvalCtx ->- CBindCateg ->- (CR.Nm2RefMp) ->- EHCOpts ->- Int ->- ( ([(HsName, CR.Bind)]),Int,Int,Int)-sem_CBind_Bind :: HsName ->- T_CBoundL ->- T_CBind-sem_CBind_Bind nm_ bindAspects_ =- (\ _lhsIisGlobal- _lhsIlev- _lhsImodNr- _lhsIrefOffset ->- (case (nm_) of- { _lhsOnm ->- (case (if _lhsIisGlobal- then CR.RRef_Glb _lhsImodNr _lhsIrefOffset- else CR.RRef_Loc _lhsIlev _lhsIrefOffset) of- { _ref ->- (case (Map.singleton nm_ _ref) of- { _nm2refGath ->- (case (_nm2refGath) of- { _lhsOnm2refGath ->- (case (_lhsIrefOffset + 1) of- { _refOffsetHere ->- (case (_refOffsetHere) of- { _lhsOrefOffset ->- (case ((let sem_CBind_Bind_1 :: T_CBind_1- sem_CBind_Bind_1 =- (\ _lhsIevalCtx- _lhsIletBindingsCateg- _lhsInm2ref- _lhsIopts- _lhsIstackDepth ->- (case (_lhsIstackDepth) of- { _bindAspectsOstackDepth ->- (case (_lhsIrefOffset) of- { _bindAspectsOrefOffset ->- (case (_lhsInm2ref) of- { _bindAspectsOnm2ref ->- (case (_lhsImodNr) of- { _bindAspectsOmodNr ->- (case (_lhsIlev) of- { _bindAspectsOlev ->- (case (_lhsIisGlobal) of- { _bindAspectsOisGlobal ->- (case (_lhsIevalCtx) of- { _bindAspectsOevalCtx ->- (case (nm_) of- { _bindAspectsOnm ->- (case (_lhsIopts) of- { _bindAspectsOopts ->- (case (_lhsIletBindingsCateg) of- { _bindAspectsOletBindingsCateg ->- (case (bindAspects_ _bindAspectsOevalCtx _bindAspectsOisGlobal _bindAspectsOletBindingsCateg _bindAspectsOlev _bindAspectsOmodNr _bindAspectsOnm _bindAspectsOnm2ref _bindAspectsOopts _bindAspectsOrefOffset _bindAspectsOstackDepth) of- { ( _bindAspectsIcrb,_bindAspectsInm2refGath,_bindAspectsIrefOffset,_bindAspectsIrefOffsetMax,_bindAspectsIstackDepth,_bindAspectsIstackDepthMax) ->- (case (take 1 _bindAspectsIcrb) of- { _crb ->- (case (_crb) of- { _lhsOcrb ->- (case (_bindAspectsIrefOffsetMax) of- { _lhsOrefOffsetMax ->- (case (_bindAspectsIstackDepth) of- { _lhsOstackDepth ->- (case (_bindAspectsIstackDepthMax) of- { _lhsOstackDepthMax ->- ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CBind_Bind_1)) of- { ( sem_CBind_1) ->- ( _lhsOnm,_lhsOnm2refGath,_lhsOrefOffset,sem_CBind_1) }) }) }) }) }) }) }))--- CBindAnn -----------------------------------------------------{-- visit 0:- inherited attributes:- lev : Int- modNr : Int- nm2ref : CR.Nm2RefMp- opts : EHCOpts- chained attributes:- refOffset : Int- stackDepth : Int- alternatives:- alternative Coe:- child coe : {RelevCoe}--}--- cata-sem_CBindAnn :: CBindAnn ->- T_CBindAnn-sem_CBindAnn (CBindAnn_Coe _coe) =- (sem_CBindAnn_Coe _coe)--- semantic domain-type T_CBindAnn = Int ->- Int ->- (CR.Nm2RefMp) ->- EHCOpts ->- Int ->- Int ->- ( Int,Int)-sem_CBindAnn_Coe :: RelevCoe ->- T_CBindAnn-sem_CBindAnn_Coe coe_ =- (\ _lhsIlev- _lhsImodNr- _lhsInm2ref- _lhsIopts- _lhsIrefOffset- _lhsIstackDepth ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case (_lhsIstackDepth) of- { _lhsOstackDepth ->- ( _lhsOrefOffset,_lhsOstackDepth) }) }))--- CBindAnnL ----------------------------------------------------{-- visit 0:- inherited attributes:- lev : Int- modNr : Int- nm2ref : CR.Nm2RefMp- opts : EHCOpts- chained attributes:- refOffset : Int- stackDepth : Int- alternatives:- alternative Cons:- child hd : CBindAnn - child tl : CBindAnnL - alternative Nil:--}--- cata-sem_CBindAnnL :: CBindAnnL ->- T_CBindAnnL-sem_CBindAnnL list =- (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list))--- semantic domain-type T_CBindAnnL = Int ->- Int ->- (CR.Nm2RefMp) ->- EHCOpts ->- Int ->- Int ->- ( Int,Int)-sem_CBindAnnL_Cons :: T_CBindAnn ->- T_CBindAnnL ->- T_CBindAnnL-sem_CBindAnnL_Cons hd_ tl_ =- (\ _lhsIlev- _lhsImodNr- _lhsInm2ref- _lhsIopts- _lhsIrefOffset- _lhsIstackDepth ->- (case (_lhsIrefOffset) of- { _hdOrefOffset ->- (case (_lhsIstackDepth) of- { _hdOstackDepth ->- (case (_lhsIopts) of- { _hdOopts ->- (case (_lhsInm2ref) of- { _hdOnm2ref ->- (case (_lhsImodNr) of- { _hdOmodNr ->- (case (_lhsIlev) of- { _hdOlev ->- (case (hd_ _hdOlev _hdOmodNr _hdOnm2ref _hdOopts _hdOrefOffset _hdOstackDepth) of- { ( _hdIrefOffset,_hdIstackDepth) ->- (case (_hdIrefOffset) of- { _tlOrefOffset ->- (case (_hdIstackDepth) of- { _tlOstackDepth ->- (case (_lhsIopts) of- { _tlOopts ->- (case (_lhsInm2ref) of- { _tlOnm2ref ->- (case (_lhsImodNr) of- { _tlOmodNr ->- (case (_lhsIlev) of- { _tlOlev ->- (case (tl_ _tlOlev _tlOmodNr _tlOnm2ref _tlOopts _tlOrefOffset _tlOstackDepth) of- { ( _tlIrefOffset,_tlIstackDepth) ->- (case (_tlIrefOffset) of- { _lhsOrefOffset ->- (case (_tlIstackDepth) of- { _lhsOstackDepth ->- ( _lhsOrefOffset,_lhsOstackDepth) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))-sem_CBindAnnL_Nil :: T_CBindAnnL-sem_CBindAnnL_Nil =- (\ _lhsIlev- _lhsImodNr- _lhsInm2ref- _lhsIopts- _lhsIrefOffset- _lhsIstackDepth ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case (_lhsIstackDepth) of- { _lhsOstackDepth ->- ( _lhsOrefOffset,_lhsOstackDepth) }) }))--- CBindL -------------------------------------------------------{-- visit 0:- inherited attributes:- isGlobal : Bool- lev : Int- modNr : Int- chained attribute:- refOffset : Int- synthesized attribute:- nm2refGath : CR.Nm2RefMp- visit 1:- inherited attributes:- evalCtx : EvalCtx- letBindingsCateg : CBindCateg- nm2ref : CR.Nm2RefMp- opts : EHCOpts- chained attribute:- stackDepth : Int- synthesized attributes:- crb : [(HsName, CR.Bind)]- refOffsetMax : Int- stackDepthMax : Int- alternatives:- alternative Cons:- child hd : CBind - child tl : CBindL - alternative Nil:--}--- cata-sem_CBindL :: CBindL ->- T_CBindL-sem_CBindL list =- (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list))--- semantic domain-type T_CBindL = Bool ->- Int ->- Int ->- Int ->- ( (CR.Nm2RefMp),Int,T_CBindL_1)-type T_CBindL_1 = EvalCtx ->- CBindCateg ->- (CR.Nm2RefMp) ->- EHCOpts ->- Int ->- ( ([(HsName, CR.Bind)]),Int,Int,Int)-sem_CBindL_Cons :: T_CBind ->- T_CBindL ->- T_CBindL-sem_CBindL_Cons hd_ tl_ =- (\ _lhsIisGlobal- _lhsIlev- _lhsImodNr- _lhsIrefOffset ->- (case (_lhsIrefOffset) of- { _hdOrefOffset ->- (case (_lhsImodNr) of- { _hdOmodNr ->- (case (_lhsIlev) of- { _hdOlev ->- (case (_lhsIisGlobal) of- { _hdOisGlobal ->- (case (hd_ _hdOisGlobal _hdOlev _hdOmodNr _hdOrefOffset) of- { ( _hdInm,_hdInm2refGath,_hdIrefOffset,hd_1) ->- (case (_hdIrefOffset) of- { _tlOrefOffset ->- (case (_lhsImodNr) of- { _tlOmodNr ->- (case (_lhsIlev) of- { _tlOlev ->- (case (_lhsIisGlobal) of- { _tlOisGlobal ->- (case (tl_ _tlOisGlobal _tlOlev _tlOmodNr _tlOrefOffset) of- { ( _tlInm2refGath,_tlIrefOffset,tl_1) ->- (case (_hdInm2refGath `Map.union` _tlInm2refGath) of- { _lhsOnm2refGath ->- (case (_tlIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CBindL_Cons_1 :: T_CBindL_1- sem_CBindL_Cons_1 =- (\ _lhsIevalCtx- _lhsIletBindingsCateg- _lhsInm2ref- _lhsIopts- _lhsIstackDepth ->- (case (_lhsIstackDepth) of- { _hdOstackDepth ->- (case (_lhsIevalCtx) of- { _hdOevalCtx ->- (case (_lhsIopts) of- { _hdOopts ->- (case (_lhsInm2ref) of- { _hdOnm2ref ->- (case (_lhsIletBindingsCateg) of- { _hdOletBindingsCateg ->- (case (hd_1 _hdOevalCtx _hdOletBindingsCateg _hdOnm2ref _hdOopts _hdOstackDepth) of- { ( _hdIcrb,_hdIrefOffsetMax,_hdIstackDepth,_hdIstackDepthMax) ->- (case (_hdIstackDepth) of- { _tlOstackDepth ->- (case (_lhsInm2ref) of- { _tlOnm2ref ->- (case (_lhsIevalCtx) of- { _tlOevalCtx ->- (case (_lhsIopts) of- { _tlOopts ->- (case (_lhsIletBindingsCateg) of- { _tlOletBindingsCateg ->- (case (tl_1 _tlOevalCtx _tlOletBindingsCateg _tlOnm2ref _tlOopts _tlOstackDepth) of- { ( _tlIcrb,_tlIrefOffsetMax,_tlIstackDepth,_tlIstackDepthMax) ->- (case (_hdIcrb ++ _tlIcrb) of- { _lhsOcrb ->- (case (_hdIrefOffsetMax `max` _tlIrefOffsetMax) of- { _lhsOrefOffsetMax ->- (case (_tlIstackDepth) of- { _lhsOstackDepth ->- (case (_hdIstackDepthMax `max` _tlIstackDepthMax) of- { _lhsOstackDepthMax ->- ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CBindL_Cons_1)) of- { ( sem_CBindL_1) ->- ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBindL_1) }) }) }) }) }) }) }) }) }) }) }) }) }))-sem_CBindL_Nil :: T_CBindL-sem_CBindL_Nil =- (\ _lhsIisGlobal- _lhsIlev- _lhsImodNr- _lhsIrefOffset ->- (case (Map.empty) of- { _lhsOnm2refGath ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CBindL_Nil_1 :: T_CBindL_1- sem_CBindL_Nil_1 =- (\ _lhsIevalCtx- _lhsIletBindingsCateg- _lhsInm2ref- _lhsIopts- _lhsIstackDepth ->- (case ([]) of- { _lhsOcrb ->- (case (0) of- { _lhsOrefOffsetMax ->- (case (_lhsIstackDepth) of- { _lhsOstackDepth ->- (case (0) of- { _lhsOstackDepthMax ->- ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }))- in sem_CBindL_Nil_1)) of- { ( sem_CBindL_1) ->- ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBindL_1) }) }) }))--- CBound -------------------------------------------------------{-- visit 0:- inherited attributes:- evalCtx : EvalCtx- isGlobal : Bool- lev : Int- modNr : Int- nm : HsName- chained attribute:- refOffset : Int- synthesized attribute:- nm2refGath : CR.Nm2RefMp- visit 1:- inherited attributes:- isTopApp : Bool- isTopTup : Bool- letBindingsCateg : CBindCateg- nm2ref : CR.Nm2RefMp- opts : EHCOpts- chained attribute:- stackDepth : Int- synthesized attributes:- crb : [(HsName, CR.Bind)]- refOffsetMax : Int- stackDepthMax : Int- alternatives:- alternative Bind:- child bindMeta : CMetas - child expr : CExpr - visit 0:- local whatAbove : {WhatExpr}- local toBe : _- local isToBeThunked : _- local lev : _- local refOffsetExpr : _- visit 1:- local tailCtx : _- local nm2refNew : _- local isToBeALam : _- local stackDepthMaxThunked : _- local creMkForce : _- local creBind : _- local crb : _- local stackDepthExpr : _- intra isToBeThunked : _- intra toBe : _- alternative Meta:- child aspectKeyS : {ACoreBindAspectKeyS}- child cmetas : CMetas - alternative RelevTy:- child aspectKeyS : {ACoreBindAspectKeyS}- child relevTy : {RelevTy}- alternative Val:- child aspectKeyS : {ACoreBindAspectKeyS}- child mlev : {MetaLev}- child lbl : {CLbl}- child expr : CExpr - visit 0:- local whatAbove : {WhatExpr}- local toBe : _- local isToBeThunked : _- local lev : _- local refOffsetExpr : _- visit 1:- local tailCtx : _- local nm2refNew : _- local isToBeALam : _- local stackDepthMaxThunked : _- local creMkForce : _- local creBind : _- local crb : _- local stackDepthExpr : _- intra isToBeThunked : _- intra toBe : _- alternative Ty:- child aspectKeyS : {ACoreBindAspectKeyS}- child ty : {Ty}- alternative FFE:- child callconv : {FFIWay}- child expEnt : {ForeignEnt}- child expr : CExpr - child ty : {Ty}- visit 0:- local whatAbove : {WhatExpr}- visit 1:- local tailCtx : _--}--- cata-sem_CBound :: CBound ->- T_CBound-sem_CBound (CBound_Bind _bindMeta _expr) =- (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr))-sem_CBound (CBound_Meta _aspectKeyS _cmetas) =- (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas))-sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) =- (sem_CBound_RelevTy _aspectKeyS _relevTy)-sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) =- (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr))-sem_CBound (CBound_Ty _aspectKeyS _ty) =- (sem_CBound_Ty _aspectKeyS _ty)-sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) =- (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty)--- semantic domain-type T_CBound = EvalCtx ->- Bool ->- Int ->- Int ->- HsName ->- Int ->- ( (CR.Nm2RefMp),Int,T_CBound_1)-type T_CBound_1 = Bool ->- Bool ->- CBindCateg ->- (CR.Nm2RefMp) ->- EHCOpts ->- Int ->- ( ([(HsName, CR.Bind)]),Int,Int,Int)-sem_CBound_Bind :: T_CMetas ->- T_CExpr ->- T_CBound-sem_CBound_Bind bindMeta_ expr_ =- (\ _lhsIevalCtx- _lhsIisGlobal- _lhsIlev- _lhsImodNr- _lhsInm- _lhsIrefOffset ->- (case (ExprIsBind _lhsInm) of- { _whatAbove ->- (case (_whatAbove) of- { _exprOwhatAbove ->- (case (_lhsImodNr) of- { _exprOmodNr ->- (case (expr_) of- { ( _exprIwhatBelow,expr_1) ->- (case (let mba@(~(Just (_,w))) = whatExprMbApp _exprIwhatBelow- isVar = isJust $ whatExprMbVar _exprIwhatBelow- isGlbVar = isVar && _lhsIisGlobal- isApp = isJust mba- isTup = isApp && whatExprIsTup w- isWHNF = whatExprIsWHNF _exprIwhatBelow- isNotWHNF = not isWHNF- in case _lhsIevalCtx of- EvalCtx_Eval- | isApp -> ToBe_LeftAsIs- | isVar -> ToBe_Forced- | isNotWHNF -> ToBe_Forced- EvalCtx_Thunk- | isTup -> ToBe_LeftAsIs- | isGlbVar -> ToBe_Thunked- | isNotWHNF -> ToBe_Thunked- _ -> ToBe_LeftAsIs) of- { _toBe ->- (case (_toBe == ToBe_Thunked) of- { _isToBeThunked ->- (case (if _isToBeThunked then _lhsIlev + 1 else _lhsIlev) of- { _lev ->- (case (_lev) of- { _exprOlev ->- (case (if _isToBeThunked then 0 else _lhsIrefOffset) of- { _refOffsetExpr ->- (case (_refOffsetExpr) of- { _exprOrefOffset ->- (case (expr_1 _exprOlev _exprOmodNr _exprOrefOffset _exprOwhatAbove) of- { ( _exprInm2refGath,_exprIrefOffset,expr_2) ->- (case (_exprInm2refGath) of- { _lhsOnm2refGath ->- (case (if _isToBeThunked then _lhsIrefOffset else _exprIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CBound_Bind_1 :: T_CBound_1- sem_CBound_Bind_1 =- (\ _lhsIisTopApp- _lhsIisTopTup- _lhsIletBindingsCateg- _lhsInm2ref- _lhsIopts- _lhsIstackDepth ->- (case (if _isToBeThunked then TailCtx_TailCall else TailCtx_Plain) of- { _tailCtx ->- (case (_tailCtx) of- { _exprOtailCtx ->- (case (_lhsInm2ref) of- { _exprOnm2ref ->- (case (if _isToBeThunked then _exprInm2refGath else Map.empty) of- { _nm2refNew ->- (case (_isToBeThunked || whatExprIsLam _exprIwhatBelow) of- { _isToBeALam ->- (case (if _isToBeALam then 0 else _lhsIstackDepth) of- { _exprOstackDepth ->- (case (_lhsIopts) of- { _exprOopts ->- (case (_lhsIevalCtx) of- { _exprOevalCtx ->- (case (True) of- { _exprOisTopTup ->- (case (True) of- { _exprOisTopApp ->- (case (expr_2 _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of- { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax,_exprIvref) ->- (case (max _exprIstackDepth _exprIstackDepthMax) of- { _stackDepthMaxThunked ->- (case (case _toBe of- ToBe_Forced -> tailrec _tailCtx . CR.mkEval- ToBe_Thunked -> CR.Exp_Lam (Just _lhsInm) 0 (_stackDepthMaxThunked) (CR.nm2RefMpInverse _nm2refNew)- ToBe_LeftAsIs -> id) of- { _creMkForce ->- (case (_creMkForce _exprIcre) of- { _creBind ->- (case ([( _lhsInm, _creBind )]) of- { _crb ->- (case (_crb) of- { _lhsOcrb ->- (case (if _isToBeThunked then _lhsIrefOffset else max _exprIrefOffset _exprIrefOffsetMax) of- { _lhsOrefOffsetMax ->- (case (if _isToBeALam then _lhsIstackDepth+1 else _exprIstackDepth) of- { _stackDepthExpr ->- (case (_stackDepthExpr) of- { _lhsOstackDepth ->- (case (if _isToBeALam then _stackDepthExpr else _stackDepthMaxThunked) of- { _lhsOstackDepthMax ->- ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CBound_Bind_1)) of- { ( sem_CBound_1) ->- ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBound_1) }) }) }) }) }) }) }) }) }) }) }) }) }) }))-sem_CBound_Meta :: ACoreBindAspectKeyS ->- T_CMetas ->- T_CBound-sem_CBound_Meta aspectKeyS_ cmetas_ =- (\ _lhsIevalCtx- _lhsIisGlobal- _lhsIlev- _lhsImodNr- _lhsInm- _lhsIrefOffset ->- (case (Map.empty) of- { _lhsOnm2refGath ->- (case (_lhsIrefOffset) of- { _cmetasOrefOffset ->- (case (cmetas_ _cmetasOrefOffset) of- { ( _cmetasIrefOffset,cmetas_1) ->- (case (_cmetasIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CBound_Meta_1 :: T_CBound_1- sem_CBound_Meta_1 =- (\ _lhsIisTopApp- _lhsIisTopTup- _lhsIletBindingsCateg- _lhsInm2ref- _lhsIopts- _lhsIstackDepth ->- (case ([]) of- { _lhsOcrb ->- (case (0) of- { _lhsOrefOffsetMax ->- (case (_lhsIstackDepth) of- { _cmetasOstackDepth ->- (case (_lhsIopts) of- { _cmetasOopts ->- (case (_lhsInm2ref) of- { _cmetasOnm2ref ->- (case (_lhsImodNr) of- { _cmetasOmodNr ->- (case (_lhsIlev) of- { _cmetasOlev ->- (case (cmetas_1 _cmetasOlev _cmetasOmodNr _cmetasOnm2ref _cmetasOopts _cmetasOstackDepth) of- { ( _cmetasIstackDepth) ->- (case (_cmetasIstackDepth) of- { _lhsOstackDepth ->- (case (0) of- { _lhsOstackDepthMax ->- ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }))- in sem_CBound_Meta_1)) of- { ( sem_CBound_1) ->- ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBound_1) }) }) }) }) }))-sem_CBound_RelevTy :: ACoreBindAspectKeyS ->- RelevTy ->- T_CBound-sem_CBound_RelevTy aspectKeyS_ relevTy_ =- (\ _lhsIevalCtx- _lhsIisGlobal- _lhsIlev- _lhsImodNr- _lhsInm- _lhsIrefOffset ->- (case (Map.empty) of- { _lhsOnm2refGath ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CBound_RelevTy_1 :: T_CBound_1- sem_CBound_RelevTy_1 =- (\ _lhsIisTopApp- _lhsIisTopTup- _lhsIletBindingsCateg- _lhsInm2ref- _lhsIopts- _lhsIstackDepth ->- (case ([]) of- { _lhsOcrb ->- (case (0) of- { _lhsOrefOffsetMax ->- (case (_lhsIstackDepth) of- { _lhsOstackDepth ->- (case (0) of- { _lhsOstackDepthMax ->- ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }))- in sem_CBound_RelevTy_1)) of- { ( sem_CBound_1) ->- ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBound_1) }) }) }))-sem_CBound_Val :: ACoreBindAspectKeyS ->- MetaLev ->- CLbl ->- T_CExpr ->- T_CBound-sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ =- (\ _lhsIevalCtx- _lhsIisGlobal- _lhsIlev- _lhsImodNr- _lhsInm- _lhsIrefOffset ->- (case (ExprIsBind _lhsInm) of- { _whatAbove ->- (case (_whatAbove) of- { _exprOwhatAbove ->- (case (_lhsImodNr) of- { _exprOmodNr ->- (case (expr_) of- { ( _exprIwhatBelow,expr_1) ->- (case (let mba@(~(Just (_,w))) = whatExprMbApp _exprIwhatBelow- isVar = isJust $ whatExprMbVar _exprIwhatBelow- isGlbVar = isVar && _lhsIisGlobal- isApp = isJust mba- isTup = isApp && whatExprIsTup w- isWHNF = whatExprIsWHNF _exprIwhatBelow- isNotWHNF = not isWHNF- in case _lhsIevalCtx of- EvalCtx_Eval- | isApp -> ToBe_LeftAsIs- | isVar -> ToBe_Forced- | isNotWHNF -> ToBe_Forced- EvalCtx_Thunk- | isTup -> ToBe_LeftAsIs- | isGlbVar -> ToBe_Thunked- | isNotWHNF -> ToBe_Thunked- _ -> ToBe_LeftAsIs) of- { _toBe ->- (case (_toBe == ToBe_Thunked) of- { _isToBeThunked ->- (case (if _isToBeThunked then _lhsIlev + 1 else _lhsIlev) of- { _lev ->- (case (_lev) of- { _exprOlev ->- (case (if _isToBeThunked then 0 else _lhsIrefOffset) of- { _refOffsetExpr ->- (case (_refOffsetExpr) of- { _exprOrefOffset ->- (case (expr_1 _exprOlev _exprOmodNr _exprOrefOffset _exprOwhatAbove) of- { ( _exprInm2refGath,_exprIrefOffset,expr_2) ->- (case (_exprInm2refGath) of- { _lhsOnm2refGath ->- (case (if _isToBeThunked then _lhsIrefOffset else _exprIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CBound_Val_1 :: T_CBound_1- sem_CBound_Val_1 =- (\ _lhsIisTopApp- _lhsIisTopTup- _lhsIletBindingsCateg- _lhsInm2ref- _lhsIopts- _lhsIstackDepth ->- (case (if _isToBeThunked then TailCtx_TailCall else TailCtx_Plain) of- { _tailCtx ->- (case (_tailCtx) of- { _exprOtailCtx ->- (case (_lhsInm2ref) of- { _exprOnm2ref ->- (case (if _isToBeThunked then _exprInm2refGath else Map.empty) of- { _nm2refNew ->- (case (_isToBeThunked || whatExprIsLam _exprIwhatBelow) of- { _isToBeALam ->- (case (if _isToBeALam then 0 else _lhsIstackDepth) of- { _exprOstackDepth ->- (case (_lhsIopts) of- { _exprOopts ->- (case (_lhsIisTopTup) of- { _exprOisTopTup ->- (case (_lhsIisTopApp) of- { _exprOisTopApp ->- (case (_lhsIevalCtx) of- { _exprOevalCtx ->- (case (expr_2 _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of- { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax,_exprIvref) ->- (case (max _exprIstackDepth _exprIstackDepthMax) of- { _stackDepthMaxThunked ->- (case (case _toBe of- ToBe_Forced -> tailrec _tailCtx . CR.mkEval- ToBe_Thunked -> CR.Exp_Lam (Just _lhsInm) 0 (_stackDepthMaxThunked) (CR.nm2RefMpInverse _nm2refNew)- ToBe_LeftAsIs -> id) of- { _creMkForce ->- (case (_creMkForce _exprIcre) of- { _creBind ->- (case ([( _lhsInm, _creBind )]) of- { _crb ->- (case (_crb) of- { _lhsOcrb ->- (case (if _isToBeThunked then _lhsIrefOffset else max _exprIrefOffset _exprIrefOffsetMax) of- { _lhsOrefOffsetMax ->- (case (if _isToBeALam then _lhsIstackDepth+1 else _exprIstackDepth) of- { _stackDepthExpr ->- (case (_stackDepthExpr) of- { _lhsOstackDepth ->- (case (if _isToBeALam then _stackDepthExpr else _stackDepthMaxThunked) of- { _lhsOstackDepthMax ->- ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CBound_Val_1)) of- { ( sem_CBound_1) ->- ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBound_1) }) }) }) }) }) }) }) }) }) }) }) }) }) }))-sem_CBound_Ty :: ACoreBindAspectKeyS ->- Ty ->- T_CBound-sem_CBound_Ty aspectKeyS_ ty_ =- (\ _lhsIevalCtx- _lhsIisGlobal- _lhsIlev- _lhsImodNr- _lhsInm- _lhsIrefOffset ->- (case (Map.empty) of- { _lhsOnm2refGath ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CBound_Ty_1 :: T_CBound_1- sem_CBound_Ty_1 =- (\ _lhsIisTopApp- _lhsIisTopTup- _lhsIletBindingsCateg- _lhsInm2ref- _lhsIopts- _lhsIstackDepth ->- (case ([]) of- { _lhsOcrb ->- (case (0) of- { _lhsOrefOffsetMax ->- (case (_lhsIstackDepth) of- { _lhsOstackDepth ->- (case (0) of- { _lhsOstackDepthMax ->- ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }))- in sem_CBound_Ty_1)) of- { ( sem_CBound_1) ->- ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBound_1) }) }) }))-sem_CBound_FFE :: FFIWay ->- ForeignEnt ->- T_CExpr ->- Ty ->- T_CBound-sem_CBound_FFE callconv_ expEnt_ expr_ ty_ =- (\ _lhsIevalCtx- _lhsIisGlobal- _lhsIlev- _lhsImodNr- _lhsInm- _lhsIrefOffset ->- (case (ExprIsLam 0 Nothing) of- { _whatAbove ->- (case (_whatAbove) of- { _exprOwhatAbove ->- (case (_lhsIrefOffset) of- { _exprOrefOffset ->- (case (_lhsImodNr) of- { _exprOmodNr ->- (case (_lhsIlev) of- { _exprOlev ->- (case (expr_) of- { ( _exprIwhatBelow,expr_1) ->- (case (expr_1 _exprOlev _exprOmodNr _exprOrefOffset _exprOwhatAbove) of- { ( _exprInm2refGath,_exprIrefOffset,expr_2) ->- (case (_exprInm2refGath) of- { _lhsOnm2refGath ->- (case (_exprIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CBound_FFE_1 :: T_CBound_1- sem_CBound_FFE_1 =- (\ _lhsIisTopApp- _lhsIisTopTup- _lhsIletBindingsCateg- _lhsInm2ref- _lhsIopts- _lhsIstackDepth ->- (case (_lhsIstackDepth) of- { _exprOstackDepth ->- (case (_lhsInm2ref) of- { _exprOnm2ref ->- (case (TailCtx_Plain) of- { _tailCtx ->- (case (_tailCtx) of- { _exprOtailCtx ->- (case (_lhsIopts) of- { _exprOopts ->- (case (_lhsIevalCtx) of- { _exprOevalCtx ->- (case (True) of- { _exprOisTopTup ->- (case (True) of- { _exprOisTopApp ->- (case (expr_2 _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of- { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax,_exprIvref) ->- (case (_exprIcrb) of- { _lhsOcrb ->- (case (_exprIrefOffsetMax) of- { _lhsOrefOffsetMax ->- (case (_exprIstackDepth) of- { _lhsOstackDepth ->- (case (_exprIstackDepthMax) of- { _lhsOstackDepthMax ->- ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CBound_FFE_1)) of- { ( sem_CBound_1) ->- ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBound_1) }) }) }) }) }) }) }) }) }) }))--- CBoundL ------------------------------------------------------{-- visit 0:- inherited attributes:- evalCtx : EvalCtx- isGlobal : Bool- letBindingsCateg : CBindCateg- lev : Int- modNr : Int- nm : HsName- nm2ref : CR.Nm2RefMp- opts : EHCOpts- chained attributes:- refOffset : Int- stackDepth : Int- synthesized attributes:- crb : [(HsName, CR.Bind)]- nm2refGath : CR.Nm2RefMp- refOffsetMax : Int- stackDepthMax : Int- alternatives:- alternative Cons:- child hd : CBound - child tl : CBoundL - alternative Nil:--}--- cata-sem_CBoundL :: CBoundL ->- T_CBoundL-sem_CBoundL list =- (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list))--- semantic domain-type T_CBoundL = EvalCtx ->- Bool ->- CBindCateg ->- Int ->- Int ->- HsName ->- (CR.Nm2RefMp) ->- EHCOpts ->- Int ->- Int ->- ( ([(HsName, CR.Bind)]),(CR.Nm2RefMp),Int,Int,Int,Int)-sem_CBoundL_Cons :: T_CBound ->- T_CBoundL ->- T_CBoundL-sem_CBoundL_Cons hd_ tl_ =- (\ _lhsIevalCtx- _lhsIisGlobal- _lhsIletBindingsCateg- _lhsIlev- _lhsImodNr- _lhsInm- _lhsInm2ref- _lhsIopts- _lhsIrefOffset- _lhsIstackDepth ->- (case (_lhsIstackDepth) of- { _hdOstackDepth ->- (case (_lhsIrefOffset) of- { _hdOrefOffset ->- (case (_lhsInm) of- { _hdOnm ->- (case (_lhsIlev) of- { _hdOlev ->- (case (_lhsIisGlobal) of- { _hdOisGlobal ->- (case (_lhsIevalCtx) of- { _hdOevalCtx ->- (case (_lhsImodNr) of- { _hdOmodNr ->- (case (hd_ _hdOevalCtx _hdOisGlobal _hdOlev _hdOmodNr _hdOnm _hdOrefOffset) of- { ( _hdInm2refGath,_hdIrefOffset,hd_1) ->- (case (_lhsIopts) of- { _hdOopts ->- (case (_lhsInm2ref) of- { _hdOnm2ref ->- (case (_lhsIletBindingsCateg) of- { _hdOletBindingsCateg ->- (case (True) of- { _hdOisTopTup ->- (case (True) of- { _hdOisTopApp ->- (case (hd_1 _hdOisTopApp _hdOisTopTup _hdOletBindingsCateg _hdOnm2ref _hdOopts _hdOstackDepth) of- { ( _hdIcrb,_hdIrefOffsetMax,_hdIstackDepth,_hdIstackDepthMax) ->- (case (_hdIstackDepth) of- { _tlOstackDepth ->- (case (_hdIrefOffset) of- { _tlOrefOffset ->- (case (_lhsInm2ref) of- { _tlOnm2ref ->- (case (_lhsInm) of- { _tlOnm ->- (case (_lhsImodNr) of- { _tlOmodNr ->- (case (_lhsIlev) of- { _tlOlev ->- (case (_lhsIisGlobal) of- { _tlOisGlobal ->- (case (_lhsIevalCtx) of- { _tlOevalCtx ->- (case (_lhsIopts) of- { _tlOopts ->- (case (_lhsIletBindingsCateg) of- { _tlOletBindingsCateg ->- (case (tl_ _tlOevalCtx _tlOisGlobal _tlOletBindingsCateg _tlOlev _tlOmodNr _tlOnm _tlOnm2ref _tlOopts _tlOrefOffset _tlOstackDepth) of- { ( _tlIcrb,_tlInm2refGath,_tlIrefOffset,_tlIrefOffsetMax,_tlIstackDepth,_tlIstackDepthMax) ->- (case (_hdIcrb ++ _tlIcrb) of- { _lhsOcrb ->- (case (_hdInm2refGath `Map.union` _tlInm2refGath) of- { _lhsOnm2refGath ->- (case (_tlIrefOffset) of- { _lhsOrefOffset ->- (case (_hdIrefOffsetMax `max` _tlIrefOffsetMax) of- { _lhsOrefOffsetMax ->- (case (_tlIstackDepth) of- { _lhsOstackDepth ->- (case (_hdIstackDepthMax `max` _tlIstackDepthMax) of- { _lhsOstackDepthMax ->- ( _lhsOcrb,_lhsOnm2refGath,_lhsOrefOffset,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))-sem_CBoundL_Nil :: T_CBoundL-sem_CBoundL_Nil =- (\ _lhsIevalCtx- _lhsIisGlobal- _lhsIletBindingsCateg- _lhsIlev- _lhsImodNr- _lhsInm- _lhsInm2ref- _lhsIopts- _lhsIrefOffset- _lhsIstackDepth ->- (case ([]) of- { _lhsOcrb ->- (case (Map.empty) of- { _lhsOnm2refGath ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case (0) of- { _lhsOrefOffsetMax ->- (case (_lhsIstackDepth) of- { _lhsOstackDepth ->- (case (0) of- { _lhsOstackDepthMax ->- ( _lhsOcrb,_lhsOnm2refGath,_lhsOrefOffset,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }))--- CDataCon -----------------------------------------------------{-- visit 0:- synthesized attribute:- crdc : [CR.DataCon]- alternatives:- alternative Con:- child conNm : {HsName}- child tagNr : {Int}- child arity : {Int}--}--- cata-sem_CDataCon :: CDataCon ->- T_CDataCon-sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) =- (sem_CDataCon_Con _conNm _tagNr _arity)--- semantic domain-type T_CDataCon = ( ([CR.DataCon]))-sem_CDataCon_Con :: HsName ->- Int ->- Int ->- T_CDataCon-sem_CDataCon_Con conNm_ tagNr_ arity_ =- (case ([CR.DataCon_Con (hsnQualified conNm_) tagNr_]) of- { _lhsOcrdc ->- ( _lhsOcrdc) })--- CDataConL ----------------------------------------------------{-- visit 0:- synthesized attribute:- crdc : [CR.DataCon]- alternatives:- alternative Cons:- child hd : CDataCon - child tl : CDataConL - alternative Nil:--}--- cata-sem_CDataConL :: CDataConL ->- T_CDataConL-sem_CDataConL list =- (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list))--- semantic domain-type T_CDataConL = ( ([CR.DataCon]))-sem_CDataConL_Cons :: T_CDataCon ->- T_CDataConL ->- T_CDataConL-sem_CDataConL_Cons hd_ tl_ =- (case (tl_) of- { ( _tlIcrdc) ->- (case (hd_) of- { ( _hdIcrdc) ->- (case (_hdIcrdc ++ _tlIcrdc) of- { _lhsOcrdc ->- ( _lhsOcrdc) }) }) })-sem_CDataConL_Nil :: T_CDataConL-sem_CDataConL_Nil =- (case ([]) of- { _lhsOcrdc ->- ( _lhsOcrdc) })--- CDeclMeta ----------------------------------------------------{-- visit 0:- synthesized attribute:- crmt : [CR.Meta]- alternatives:- alternative Data:- child tyNm : {HsName}- child dataCons : CDataConL --}--- cata-sem_CDeclMeta :: CDeclMeta ->- T_CDeclMeta-sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) =- (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons))--- semantic domain-type T_CDeclMeta = ( ([CR.Meta]))-sem_CDeclMeta_Data :: HsName ->- T_CDataConL ->- T_CDeclMeta-sem_CDeclMeta_Data tyNm_ dataCons_ =- (case (dataCons_) of- { ( _dataConsIcrdc) ->- (case ([CR.Meta_Data tyNm_ _dataConsIcrdc]) of- { _lhsOcrmt ->- ( _lhsOcrmt) }) })--- CDeclMetaL ---------------------------------------------------{-- visit 0:- synthesized attribute:- crmt : [CR.Meta]- alternatives:- alternative Cons:- child hd : CDeclMeta - child tl : CDeclMetaL - alternative Nil:--}--- cata-sem_CDeclMetaL :: CDeclMetaL ->- T_CDeclMetaL-sem_CDeclMetaL list =- (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list))--- semantic domain-type T_CDeclMetaL = ( ([CR.Meta]))-sem_CDeclMetaL_Cons :: T_CDeclMeta ->- T_CDeclMetaL ->- T_CDeclMetaL-sem_CDeclMetaL_Cons hd_ tl_ =- (case (tl_) of- { ( _tlIcrmt) ->- (case (hd_) of- { ( _hdIcrmt) ->- (case (_hdIcrmt ++ _tlIcrmt) of- { _lhsOcrmt ->- ( _lhsOcrmt) }) }) })-sem_CDeclMetaL_Nil :: T_CDeclMetaL-sem_CDeclMetaL_Nil =- (case ([]) of- { _lhsOcrmt ->- ( _lhsOcrmt) })--- CExport ------------------------------------------------------{-- alternatives:- alternative Export:- child nm : {HsName}- alternative ExportData:- child nm : {HsName}- child mbConNmL : {Maybe [HsName]}--}--- cata-sem_CExport :: CExport ->- T_CExport-sem_CExport (CExport_Export _nm) =- (sem_CExport_Export _nm)-sem_CExport (CExport_ExportData _nm _mbConNmL) =- (sem_CExport_ExportData _nm _mbConNmL)--- semantic domain-type T_CExport = ( )-sem_CExport_Export :: HsName ->- T_CExport-sem_CExport_Export nm_ =- ( )-sem_CExport_ExportData :: HsName ->- (Maybe [HsName]) ->- T_CExport-sem_CExport_ExportData nm_ mbConNmL_ =- ( )--- CExportL -----------------------------------------------------{-- alternatives:- alternative Cons:- child hd : CExport - child tl : CExportL - alternative Nil:--}--- cata-sem_CExportL :: CExportL ->- T_CExportL-sem_CExportL list =- (Prelude.foldr sem_CExportL_Cons sem_CExportL_Nil (Prelude.map sem_CExport list))--- semantic domain-type T_CExportL = ( )-sem_CExportL_Cons :: T_CExport ->- T_CExportL ->- T_CExportL-sem_CExportL_Cons hd_ tl_ =- ( )-sem_CExportL_Nil :: T_CExportL-sem_CExportL_Nil =- ( )--- CExpr --------------------------------------------------------{-- visit 0:- synthesized attribute:- whatBelow : WhatExpr- visit 1:- inherited attributes:- lev : Int- modNr : Int- whatAbove : WhatExpr- chained attribute:- refOffset : Int- synthesized attribute:- nm2refGath : CR.Nm2RefMp- visit 2:- inherited attributes:- evalCtx : EvalCtx- isTopApp : Bool- isTopTup : Bool- nm2ref : CR.Nm2RefMp- opts : EHCOpts- tailCtx : TailCtx- chained attribute:- stackDepth : Int- synthesized attributes:- appFunKind : AppFunKind- crb : [(HsName, CR.Bind)]- cre : CR.Exp- creAppArgL : [CR.SExp]- creAppFun : TailCtx -> CR.CRArray CR.SExp -> CR.Exp- creLamArgL : [HsName]- creLamBody : CR.Exp- crse : CR.SExp- mbFFIApp : Maybe ( Ty- , Bool- , FFIWay- , ForeignEnt- , [Ty]- )- mbLam : Maybe [HsName]- mbVar : Maybe HsName- refOffsetMax : Int- stackDepthMax : Int- vref : CR.RRef- alternatives:- alternative Var:- child ref : {ACoreBindRef}- visit 0:- local nm : {HsName}- local whatBelow : _- visit 1:- intra nm : {HsName}- visit 2:- local vref : _- local crse : _- local creBase : _- local cre : _- local creAppArgL : _- local creAppFun : _- local creLamArgL : _- local creLamBody : _- local mbVar : {Maybe HsName}- local stackDepthHere : _- intra nm : {HsName}- alternative Int:- child int : {Int}- visit 0:- local whatBelow : _- visit 2:- local crse : _- local creBase : _- local cre : _- local creAppArgL : _- local creAppFun : _- local creLamArgL : _- local creLamBody : _- local stackDepthHere : _- local vref : _- alternative Char:- child char : {Char}- visit 0:- local whatBelow : _- visit 2:- local crse : _- local creBase : _- local cre : _- local creAppArgL : _- local creAppFun : _- local creLamArgL : _- local creLamBody : _- local stackDepthHere : _- local vref : _- alternative String:- child str : {String}- visit 0:- local whatBelow : _- visit 2:- local crse : _- local creBase : _- local cre : _- local creAppArgL : _- local creAppFun : _- local creLamArgL : _- local creLamBody : _- local stackDepthHere : _- local vref : _- alternative Integer:- child integer : {Integer}- visit 0:- local whatBelow : _- visit 2:- local crse : _- local creBase : _- local cre : _- local creAppArgL : _- local creAppFun : _- local creLamArgL : _- local creLamBody : _- local stackDepthHere : _- local vref : _- alternative Tup:- child tag : {CTag}- visit 0:- local whatBelow : _- visit 2:- local creBase : _- local cre : _- local creAppArgL : _- local creAppFun : _- local creLamArgL : _- local creLamBody : _- local crse : _- local stackDepthHere : _- local vref : _- alternative Let:- child categ : {CBindCateg}- child binds : CBindL - child body : CExpr - visit 0:- local whatBelow : _- visit 1:- local whatAbove : {WhatExpr}- local isGlobal : _- local _tup1 : _- visit 2:- local evalCtx : _- local letBindingsCateg : _- local _tup2 : _- local isTopTup : _- local isTopApp : {Bool}- local nm2refNew : _- local creBase : _- local cre : _- local creAppArgL : _- local creAppFun : _- local creLamArgL : _- local creLamBody : _- local crse : _- local refOffsetMax : _- local stackDepthMax : _- local vref : _- intra isGlobal : _- intra _tup1 : _- alternative App:- child func : CExpr - child arg : CBound - visit 0:- local whatBelow : _- visit 1:- local whatAbove : {WhatExpr}- local isGlobal : _- visit 2:- local tailCtx : _- local isTopTup : _- local creAppFun : _- local stackDepthFunc : _- local letBindingsCateg : _- local creAppArgL : _- local isTopApp' : _- local creBase : _- local cre : _- local creLamArgL : _- local creLamBody : _- local crse : _- local stackDepthMax : _- local vref : _- alternative Lam:- child bind : CBind - child body : CExpr - visit 0:- local whatBelow : _- visit 1:- local whatAbove : {WhatExpr}- local isTopLam : _- local lev : _- local _tup3 : _- local refOffsetBody : _- local refOffset : _- local isGlobal : _- local nm2refNew : _- visit 2:- local nm2ref : _- local isTopTup : _- local isTopApp : {Bool}- local creLamArgL : _- local stackDepthMax : _- local creBase : _- local cre : _- local creAppArgL : _- local creAppFun : _- local creLamBody : _- local crse : _- local argNm : _- local refOffsetMax : _- local vref : _- intra nm2refNew : _- intra isTopLam : _- intra refOffsetBody : _- alternative Case:- child expr : CExpr - child alts : CAltL - child dflt : CExpr - visit 0:- local whatBelow : _- visit 1:- local whatAbove : {WhatExpr}- visit 2:- local isTopTup : _- local isTopApp : {Bool}- local creBase : _- local cre : _- local creAppArgL : _- local creAppFun : _- local creLamArgL : _- local creLamBody : _- local crse : _- local stackDepthHere : _- local stackDepthMax : _- local vref : _- alternative CaseAltFail:- child failReason : {CaseAltFailReason}- child errorExpr : CExpr - visit 1:- local whatAbove : {WhatExpr}- visit 2:- local isTopTup : _- local isTopApp : {Bool}- local creBase : _- local cre : _- local creAppArgL : _- local creAppFun : _- local creLamArgL : _- local creLamBody : _- local crse : _- local stackDepthHere : _- local vref : _- alternative TupDel:- child expr : CExpr - child tag : {CTag}- child nm : {HsName}- child offset : CExpr - visit 0:- local whatBelow : _- visit 1:- local whatAbove : {WhatExpr}- visit 2:- local creBase : _- local cre : _- local creAppArgL : _- local creAppFun : _- local creLamArgL : _- local creLamBody : _- local crse : _- local isTopApp : {Bool}- local isTopTup : _- local stackDepthHere : _- local vref : _- alternative TupIns:- child expr : CExpr - child tag : {CTag}- child nm : {HsName}- child offset : CExpr - child fldExpr : CExpr - visit 0:- local whatBelow : _- visit 1:- local whatAbove : {WhatExpr}- visit 2:- local creBase : _- local cre : _- local creAppArgL : _- local creAppFun : _- local creLamArgL : _- local creLamBody : _- local crse : _- local isTopApp : {Bool}- local isTopTup : _- local stackDepthHere : _- local vref : _- alternative TupUpd:- child expr : CExpr - child tag : {CTag}- child nm : {HsName}- child offset : CExpr - child fldExpr : CExpr - visit 0:- local whatBelow : _- visit 1:- local whatAbove : {WhatExpr}- visit 2:- local creBase : _- local cre : _- local creAppArgL : _- local creAppFun : _- local creLamArgL : _- local creLamBody : _- local crse : _- local isTopApp : {Bool}- local isTopTup : _- local stackDepthHere : _- local vref : _- alternative FFI:- child callconv : {FFIWay}- child safety : {String}- child impEnt : {ForeignEnt}- child ty : {Ty}- visit 0:- local whatBelow : _- visit 2:- local foreignEntInfo : _- local creEntMb : _- local creMk : _- local creBase : _- local cre : _- local creAppArgL : _- local creAppFun : _- local creLamArgL : _- local creLamBody : _- local crse : _- local mbPrimNeedEval : {Maybe PrimitiveNeedsEval}- local primResNeedsEval : {Bool}- local argTyLresTy : {( TyL, Ty )}- local resTy : _- local argTyL : {TyL}- local stackDepthHere : _- local vref : _- alternative Dbg:- child info : {String}- visit 0:- local whatBelow : _- visit 2:- local creBase : _- local cre : _- local creAppArgL : _- local creAppFun : _- local creLamArgL : _- local creLamBody : _- local crse : _- local stackDepthHere : _- local vref : _- alternative Hole:- child uid : {UID}- visit 0:- local whatBelow : _- visit 2:- local creBase : _- local cre : _- local creAppArgL : _- local creAppFun : _- local creLamArgL : _- local creLamBody : _- local crse : _- local stackDepthHere : _- local vref : _- alternative HoleLet:- child bindsUid : {UID}- child body : CExpr - visit 0:- local whatBelow : _- visit 1:- local whatAbove : {WhatExpr}- visit 2:- local creBase : _- local cre : _- local creAppArgL : _- local creAppFun : _- local creLamArgL : _- local creLamBody : _- local crse : _- local isTopTup : _- local isTopApp : {Bool}- local stackDepthHere : _- local vref : _- alternative CoeArg:- visit 0:- local whatBelow : _- visit 2:- local creBase : _- local cre : _- local creAppArgL : _- local creAppFun : _- local creLamArgL : _- local creLamBody : _- local crse : _- local stackDepthHere : _- local vref : _- alternative ImplsApp:- child func : CExpr - child uid : {ImplsVarId}- visit 0:- local whatBelow : _- visit 1:- local whatAbove : {WhatExpr}- visit 2:- local creBase : _- local cre : _- local creAppArgL : _- local creAppFun : _- local creLamArgL : _- local creLamBody : _- local crse : _- local isTopTup : _- local isTopApp : {Bool}- local stackDepthHere : _- local vref : _- alternative ImplsLam:- child uid : {ImplsVarId}- child body : CExpr - visit 0:- local whatBelow : _- visit 1:- local whatAbove : {WhatExpr}- visit 2:- local creBase : _- local cre : _- local creAppArgL : _- local creAppFun : _- local creLamArgL : _- local creLamBody : _- local crse : _- local isTopTup : _- local isTopApp : {Bool}- local stackDepthHere : _- local vref : _- alternative Ann:- child ann : CExprAnn - child expr : CExpr - visit 2:- local crse : _- local vref : _--}--- cata-sem_CExpr :: CExpr ->- T_CExpr-sem_CExpr (CExpr_Var _ref) =- (sem_CExpr_Var _ref)-sem_CExpr (CExpr_Int _int) =- (sem_CExpr_Int _int)-sem_CExpr (CExpr_Char _char) =- (sem_CExpr_Char _char)-sem_CExpr (CExpr_String _str) =- (sem_CExpr_String _str)-sem_CExpr (CExpr_Integer _integer) =- (sem_CExpr_Integer _integer)-sem_CExpr (CExpr_Tup _tag) =- (sem_CExpr_Tup _tag)-sem_CExpr (CExpr_Let _categ _binds _body) =- (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body))-sem_CExpr (CExpr_App _func _arg) =- (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg))-sem_CExpr (CExpr_Lam _bind _body) =- (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body))-sem_CExpr (CExpr_Case _expr _alts _dflt) =- (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt))-sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) =- (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr))-sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) =- (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset))-sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) =- (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr))-sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) =- (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr))-sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) =- (sem_CExpr_FFI _callconv _safety _impEnt _ty)-sem_CExpr (CExpr_Dbg _info) =- (sem_CExpr_Dbg _info)-sem_CExpr (CExpr_Hole _uid) =- (sem_CExpr_Hole _uid)-sem_CExpr (CExpr_HoleLet _bindsUid _body) =- (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body))-sem_CExpr (CExpr_CoeArg) =- (sem_CExpr_CoeArg)-sem_CExpr (CExpr_ImplsApp _func _uid) =- (sem_CExpr_ImplsApp (sem_CExpr _func) _uid)-sem_CExpr (CExpr_ImplsLam _uid _body) =- (sem_CExpr_ImplsLam _uid (sem_CExpr _body))-sem_CExpr (CExpr_Ann _ann _expr) =- (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr))--- semantic domain-type T_CExpr = ( WhatExpr,T_CExpr_1)-type T_CExpr_1 = Int ->- Int ->- Int ->- WhatExpr ->- ( (CR.Nm2RefMp),Int,T_CExpr_2)-type T_CExpr_2 = EvalCtx ->- Bool ->- Bool ->- (CR.Nm2RefMp) ->- EHCOpts ->- Int ->- TailCtx ->- ( AppFunKind,([(HsName, CR.Bind)]),(CR.Exp),([CR.SExp]),(TailCtx -> CR.CRArray CR.SExp -> CR.Exp),([HsName]),(CR.Exp),(CR.SExp),(Maybe ( Ty- , Bool- , FFIWay- , ForeignEnt- , [Ty]- )),(Maybe [HsName]),(Maybe HsName),Int,Int,Int,(CR.RRef))-sem_CExpr_Var :: ACoreBindRef ->- T_CExpr-sem_CExpr_Var ref_ =- (case (acbrefNm ref_) of- { _nm ->- (case (ExprIsVar _nm) of- { _whatBelow ->- (case (_whatBelow) of- { _lhsOwhatBelow ->- (case ((let sem_CExpr_Var_1 :: T_CExpr_1- sem_CExpr_Var_1 =- (\ _lhsIlev- _lhsImodNr- _lhsIrefOffset- _lhsIwhatAbove ->- (case (Map.empty) of- { _lhsOnm2refGath ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CExpr_Var_2 :: T_CExpr_2- sem_CExpr_Var_2 =- (\ _lhsIevalCtx- _lhsIisTopApp- _lhsIisTopTup- _lhsInm2ref- _lhsIopts- _lhsIstackDepth- _lhsItailCtx ->- (case (AppFunKind_Fun ref_) of- { _lhsOappFunKind ->- (case ([]) of- { _lhsOcrb ->- (case (maybe (CR.RRef_Dbg _nm) (CR.rrefToDif _lhsIlev) $ Map.lookup _nm _lhsInm2ref) of- { _vref ->- (case (CR.mkVar' _vref) of- { _crse ->- (case (taileval _lhsItailCtx $ CR.mkExp _crse) of- { _creBase ->- (case (cseCtxWrap _lhsItailCtx _creBase) of- { _cre ->- (case (_cre) of- { _lhsOcre ->- (case ([]) of- { _creAppArgL ->- (case (_creAppArgL) of- { _lhsOcreAppArgL ->- (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of- { _creAppFun ->- (case (_creAppFun) of- { _lhsOcreAppFun ->- (case ([]) of- { _creLamArgL ->- (case (_creLamArgL) of- { _lhsOcreLamArgL ->- (case (_cre) of- { _creLamBody ->- (case (_creLamBody) of- { _lhsOcreLamBody ->- (case (_crse) of- { _lhsOcrse ->- (case (Nothing) of- { _lhsOmbFFIApp ->- (case (Nothing) of- { _lhsOmbLam ->- (case (Just _nm) of- { _mbVar ->- (case (_mbVar) of- { _lhsOmbVar ->- (case (0) of- { _lhsOrefOffsetMax ->- (case (_lhsIstackDepth + 1) of- { _stackDepthHere ->- (case (_stackDepthHere) of- { _lhsOstackDepth ->- (case (_stackDepthHere) of- { _lhsOstackDepthMax ->- (case (_vref) of- { _lhsOvref ->- ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_Var_2)) of- { ( sem_CExpr_2) ->- ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }))- in sem_CExpr_Var_1)) of- { ( sem_CExpr_1) ->- ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) })-sem_CExpr_Int :: Int ->- T_CExpr-sem_CExpr_Int int_ =- (case (ExprIsInt int_) of- { _whatBelow ->- (case (_whatBelow) of- { _lhsOwhatBelow ->- (case ((let sem_CExpr_Int_1 :: T_CExpr_1- sem_CExpr_Int_1 =- (\ _lhsIlev- _lhsImodNr- _lhsIrefOffset- _lhsIwhatAbove ->- (case (Map.empty) of- { _lhsOnm2refGath ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CExpr_Int_2 :: T_CExpr_2- sem_CExpr_Int_2 =- (\ _lhsIevalCtx- _lhsIisTopApp- _lhsIisTopTup- _lhsInm2ref- _lhsIopts- _lhsIstackDepth- _lhsItailCtx ->- (case (AppFunKind_NoApp) of- { _lhsOappFunKind ->- (case ([]) of- { _lhsOcrb ->- (case (CR.mkInt' int_) of- { _crse ->- (case (CR.mkExp _crse) of- { _creBase ->- (case (cseCtxWrap _lhsItailCtx _creBase) of- { _cre ->- (case (_cre) of- { _lhsOcre ->- (case ([]) of- { _creAppArgL ->- (case (_creAppArgL) of- { _lhsOcreAppArgL ->- (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of- { _creAppFun ->- (case (_creAppFun) of- { _lhsOcreAppFun ->- (case ([]) of- { _creLamArgL ->- (case (_creLamArgL) of- { _lhsOcreLamArgL ->- (case (_cre) of- { _creLamBody ->- (case (_creLamBody) of- { _lhsOcreLamBody ->- (case (_crse) of- { _lhsOcrse ->- (case (Nothing) of- { _lhsOmbFFIApp ->- (case (Nothing) of- { _lhsOmbLam ->- (case (Nothing) of- { _lhsOmbVar ->- (case (0) of- { _lhsOrefOffsetMax ->- (case (_lhsIstackDepth + 1) of- { _stackDepthHere ->- (case (_stackDepthHere) of- { _lhsOstackDepth ->- (case (_stackDepthHere) of- { _lhsOstackDepthMax ->- (case (panic "Core.ToCoreRun.CExpr.ref") of- { _vref ->- (case (_vref) of- { _lhsOvref ->- ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_Int_2)) of- { ( sem_CExpr_2) ->- ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }))- in sem_CExpr_Int_1)) of- { ( sem_CExpr_1) ->- ( _lhsOwhatBelow,sem_CExpr_1) }) }) })-sem_CExpr_Char :: Char ->- T_CExpr-sem_CExpr_Char char_ =- (case (ExprIsOtherWHNF) of- { _whatBelow ->- (case (_whatBelow) of- { _lhsOwhatBelow ->- (case ((let sem_CExpr_Char_1 :: T_CExpr_1- sem_CExpr_Char_1 =- (\ _lhsIlev- _lhsImodNr- _lhsIrefOffset- _lhsIwhatAbove ->- (case (Map.empty) of- { _lhsOnm2refGath ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CExpr_Char_2 :: T_CExpr_2- sem_CExpr_Char_2 =- (\ _lhsIevalCtx- _lhsIisTopApp- _lhsIisTopTup- _lhsInm2ref- _lhsIopts- _lhsIstackDepth- _lhsItailCtx ->- (case (AppFunKind_NoApp) of- { _lhsOappFunKind ->- (case ([]) of- { _lhsOcrb ->- (case (CR.mkChar' char_) of- { _crse ->- (case (CR.mkExp _crse) of- { _creBase ->- (case (cseCtxWrap _lhsItailCtx _creBase) of- { _cre ->- (case (_cre) of- { _lhsOcre ->- (case ([]) of- { _creAppArgL ->- (case (_creAppArgL) of- { _lhsOcreAppArgL ->- (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of- { _creAppFun ->- (case (_creAppFun) of- { _lhsOcreAppFun ->- (case ([]) of- { _creLamArgL ->- (case (_creLamArgL) of- { _lhsOcreLamArgL ->- (case (_cre) of- { _creLamBody ->- (case (_creLamBody) of- { _lhsOcreLamBody ->- (case (_crse) of- { _lhsOcrse ->- (case (Nothing) of- { _lhsOmbFFIApp ->- (case (Nothing) of- { _lhsOmbLam ->- (case (Nothing) of- { _lhsOmbVar ->- (case (0) of- { _lhsOrefOffsetMax ->- (case (_lhsIstackDepth + 1) of- { _stackDepthHere ->- (case (_stackDepthHere) of- { _lhsOstackDepth ->- (case (_stackDepthHere) of- { _lhsOstackDepthMax ->- (case (panic "Core.ToCoreRun.CExpr.ref") of- { _vref ->- (case (_vref) of- { _lhsOvref ->- ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_Char_2)) of- { ( sem_CExpr_2) ->- ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }))- in sem_CExpr_Char_1)) of- { ( sem_CExpr_1) ->- ( _lhsOwhatBelow,sem_CExpr_1) }) }) })-sem_CExpr_String :: String ->- T_CExpr-sem_CExpr_String str_ =- (case (ExprIsOtherWHNF) of- { _whatBelow ->- (case (_whatBelow) of- { _lhsOwhatBelow ->- (case ((let sem_CExpr_String_1 :: T_CExpr_1- sem_CExpr_String_1 =- (\ _lhsIlev- _lhsImodNr- _lhsIrefOffset- _lhsIwhatAbove ->- (case (Map.empty) of- { _lhsOnm2refGath ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CExpr_String_2 :: T_CExpr_2- sem_CExpr_String_2 =- (\ _lhsIevalCtx- _lhsIisTopApp- _lhsIisTopTup- _lhsInm2ref- _lhsIopts- _lhsIstackDepth- _lhsItailCtx ->- (case (AppFunKind_NoApp) of- { _lhsOappFunKind ->- (case ([]) of- { _lhsOcrb ->- (case (CR.mkString' str_) of- { _crse ->- (case (CR.mkExp _crse) of- { _creBase ->- (case (cseCtxWrap _lhsItailCtx _creBase) of- { _cre ->- (case (_cre) of- { _lhsOcre ->- (case ([]) of- { _creAppArgL ->- (case (_creAppArgL) of- { _lhsOcreAppArgL ->- (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of- { _creAppFun ->- (case (_creAppFun) of- { _lhsOcreAppFun ->- (case ([]) of- { _creLamArgL ->- (case (_creLamArgL) of- { _lhsOcreLamArgL ->- (case (_cre) of- { _creLamBody ->- (case (_creLamBody) of- { _lhsOcreLamBody ->- (case (_crse) of- { _lhsOcrse ->- (case (Nothing) of- { _lhsOmbFFIApp ->- (case (Nothing) of- { _lhsOmbLam ->- (case (Nothing) of- { _lhsOmbVar ->- (case (0) of- { _lhsOrefOffsetMax ->- (case (_lhsIstackDepth + 1) of- { _stackDepthHere ->- (case (_stackDepthHere) of- { _lhsOstackDepth ->- (case (_stackDepthHere) of- { _lhsOstackDepthMax ->- (case (panic "Core.ToCoreRun.CExpr.ref") of- { _vref ->- (case (_vref) of- { _lhsOvref ->- ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_String_2)) of- { ( sem_CExpr_2) ->- ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }))- in sem_CExpr_String_1)) of- { ( sem_CExpr_1) ->- ( _lhsOwhatBelow,sem_CExpr_1) }) }) })-sem_CExpr_Integer :: Integer ->- T_CExpr-sem_CExpr_Integer integer_ =- (case (ExprIsOtherWHNF) of- { _whatBelow ->- (case (_whatBelow) of- { _lhsOwhatBelow ->- (case ((let sem_CExpr_Integer_1 :: T_CExpr_1- sem_CExpr_Integer_1 =- (\ _lhsIlev- _lhsImodNr- _lhsIrefOffset- _lhsIwhatAbove ->- (case (Map.empty) of- { _lhsOnm2refGath ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CExpr_Integer_2 :: T_CExpr_2- sem_CExpr_Integer_2 =- (\ _lhsIevalCtx- _lhsIisTopApp- _lhsIisTopTup- _lhsInm2ref- _lhsIopts- _lhsIstackDepth- _lhsItailCtx ->- (case (AppFunKind_NoApp) of- { _lhsOappFunKind ->- (case ([]) of- { _lhsOcrb ->- (case (CR.SExp_Integer integer_) of- { _crse ->- (case (CR.mkExp _crse) of- { _creBase ->- (case (cseCtxWrap _lhsItailCtx _creBase) of- { _cre ->- (case (_cre) of- { _lhsOcre ->- (case ([]) of- { _creAppArgL ->- (case (_creAppArgL) of- { _lhsOcreAppArgL ->- (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of- { _creAppFun ->- (case (_creAppFun) of- { _lhsOcreAppFun ->- (case ([]) of- { _creLamArgL ->- (case (_creLamArgL) of- { _lhsOcreLamArgL ->- (case (_cre) of- { _creLamBody ->- (case (_creLamBody) of- { _lhsOcreLamBody ->- (case (_crse) of- { _lhsOcrse ->- (case (Nothing) of- { _lhsOmbFFIApp ->- (case (Nothing) of- { _lhsOmbLam ->- (case (Nothing) of- { _lhsOmbVar ->- (case (0) of- { _lhsOrefOffsetMax ->- (case (_lhsIstackDepth + 1) of- { _stackDepthHere ->- (case (_stackDepthHere) of- { _lhsOstackDepth ->- (case (_stackDepthHere) of- { _lhsOstackDepthMax ->- (case (panic "Core.ToCoreRun.CExpr.ref") of- { _vref ->- (case (_vref) of- { _lhsOvref ->- ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_Integer_2)) of- { ( sem_CExpr_2) ->- ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }))- in sem_CExpr_Integer_1)) of- { ( sem_CExpr_1) ->- ( _lhsOwhatBelow,sem_CExpr_1) }) }) })-sem_CExpr_Tup :: CTag ->- T_CExpr-sem_CExpr_Tup tag_ =- (case (ExprIsTup tag_) of- { _whatBelow ->- (case (_whatBelow) of- { _lhsOwhatBelow ->- (case ((let sem_CExpr_Tup_1 :: T_CExpr_1- sem_CExpr_Tup_1 =- (\ _lhsIlev- _lhsImodNr- _lhsIrefOffset- _lhsIwhatAbove ->- (case (Map.empty) of- { _lhsOnm2refGath ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CExpr_Tup_2 :: T_CExpr_2- sem_CExpr_Tup_2 =- (\ _lhsIevalCtx- _lhsIisTopApp- _lhsIisTopTup- _lhsInm2ref- _lhsIopts- _lhsIstackDepth- _lhsItailCtx ->- (case (AppFunKind_Tag tag_) of- { _lhsOappFunKind ->- (case ([]) of- { _lhsOcrb ->- (case (CR.mkTup (ctagTag tag_) []) of- { _creBase ->- (case (_creBase) of- { _cre ->- (case (_cre) of- { _lhsOcre ->- (case ([]) of- { _creAppArgL ->- (case (_creAppArgL) of- { _lhsOcreAppArgL ->- (case (\_ -> cseCtxWrap TailCtx_Plain . CR.mkTup' (ctagTag tag_)) of- { _creAppFun ->- (case (_creAppFun) of- { _lhsOcreAppFun ->- (case ([]) of- { _creLamArgL ->- (case (_creLamArgL) of- { _lhsOcreLamArgL ->- (case (_cre) of- { _creLamBody ->- (case (_creLamBody) of- { _lhsOcreLamBody ->- (case (panic "Core.ToCoreRun.CExpr.crse") of- { _crse ->- (case (_crse) of- { _lhsOcrse ->- (case (Nothing) of- { _lhsOmbFFIApp ->- (case (Nothing) of- { _lhsOmbLam ->- (case (Nothing) of- { _lhsOmbVar ->- (case (0) of- { _lhsOrefOffsetMax ->- (case (_lhsIstackDepth + 1) of- { _stackDepthHere ->- (case (_stackDepthHere) of- { _lhsOstackDepth ->- (case (_stackDepthHere) of- { _lhsOstackDepthMax ->- (case (panic "Core.ToCoreRun.CExpr.ref") of- { _vref ->- (case (_vref) of- { _lhsOvref ->- ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_Tup_2)) of- { ( sem_CExpr_2) ->- ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }))- in sem_CExpr_Tup_1)) of- { ( sem_CExpr_1) ->- ( _lhsOwhatBelow,sem_CExpr_1) }) }) })-sem_CExpr_Let :: CBindCateg ->- T_CBindL ->- T_CExpr ->- T_CExpr-sem_CExpr_Let categ_ binds_ body_ =- (case (ExprIsOther) of- { _whatBelow ->- (case (_whatBelow) of- { _lhsOwhatBelow ->- (case ((let sem_CExpr_Let_1 :: T_CExpr_1- sem_CExpr_Let_1 =- (\ _lhsIlev- _lhsImodNr- _lhsIrefOffset- _lhsIwhatAbove ->- (case (ExprIsOther) of- { _whatAbove ->- (case (_whatAbove) of- { _bodyOwhatAbove ->- (case (_lhsIrefOffset) of- { _bindsOrefOffset ->- (case (_lhsImodNr) of- { _bindsOmodNr ->- (case (_lhsIlev) of- { _bindsOlev ->- (case (_lhsIlev == cLevModule) of- { _isGlobal ->- (case (_isGlobal) of- { _bindsOisGlobal ->- (case (binds_ _bindsOisGlobal _bindsOlev _bindsOmodNr _bindsOrefOffset) of- { ( _bindsInm2refGath,_bindsIrefOffset,binds_1) ->- (case (_bindsIrefOffset) of- { _bodyOrefOffset ->- (case (_lhsImodNr) of- { _bodyOmodNr ->- (case (_lhsIlev) of- { _bodyOlev ->- (case (body_) of- { ( _bodyIwhatBelow,body_1) ->- (case (body_1 _bodyOlev _bodyOmodNr _bodyOrefOffset _bodyOwhatAbove) of- { ( _bodyInm2refGath,_bodyIrefOffset,body_2) ->- (case (if _isGlobal- then (Map.empty, _bindsInm2refGath `Map.union` _bodyInm2refGath)- else (_bindsInm2refGath, Map.empty)) of- { __tup1 ->- (case (__tup1) of- { (_,_lhsOnm2refGath) ->- (case (_bodyIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CExpr_Let_2 :: T_CExpr_2- sem_CExpr_Let_2 =- (\ _lhsIevalCtx- _lhsIisTopApp- _lhsIisTopTup- _lhsInm2ref- _lhsIopts- _lhsIstackDepth- _lhsItailCtx ->- (case (AppFunKind_NoApp) of- { _lhsOappFunKind ->- (case (_lhsIstackDepth) of- { _bindsOstackDepth ->- (case (if categ_ == CBindCateg_Strict- then EvalCtx_Eval- else EvalCtx_Thunk) of- { _evalCtx ->- (case (_evalCtx) of- { _bindsOevalCtx ->- (case (_lhsIopts) of- { _bindsOopts ->- (case (categ_) of- { _letBindingsCateg ->- (case (_letBindingsCateg) of- { _bindsOletBindingsCateg ->- (case (if _isGlobal- then (_lhsInm2ref, _lhsInm2ref)- else ( case categ_ of- CBindCateg_Rec -> _bindsInm2refGath `Map.union` _lhsInm2ref- _ -> _lhsInm2ref `Map.union` _bindsInm2refGath- , _bindsInm2refGath `Map.union` _lhsInm2ref- )) of- { __tup2 ->- (case (__tup2) of- { (_bindsOnm2ref,_) ->- (case (binds_1 _bindsOevalCtx _bindsOletBindingsCateg _bindsOnm2ref _bindsOopts _bindsOstackDepth) of- { ( _bindsIcrb,_bindsIrefOffsetMax,_bindsIstackDepth,_bindsIstackDepthMax) ->- (case (_bindsIstackDepth) of- { _bodyOstackDepth ->- (case (__tup2) of- { (_,_bodyOnm2ref) ->- (case (_lhsItailCtx) of- { _bodyOtailCtx ->- (case (_lhsIopts) of- { _bodyOopts ->- (case (True) of- { _isTopTup ->- (case (_isTopTup) of- { _bodyOisTopTup ->- (case (True) of- { _isTopApp ->- (case (_isTopApp) of- { _bodyOisTopApp ->- (case (_evalCtx) of- { _bodyOevalCtx ->- (case (body_2 _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOnm2ref _bodyOopts _bodyOstackDepth _bodyOtailCtx) of- { ( _bodyIappFunKind,_bodyIcrb,_bodyIcre,_bodyIcreAppArgL,_bodyIcreAppFun,_bodyIcreLamArgL,_bodyIcreLamBody,_bodyIcrse,_bodyImbFFIApp,_bodyImbLam,_bodyImbVar,_bodyIrefOffsetMax,_bodyIstackDepth,_bodyIstackDepthMax,_bodyIvref) ->- (case (if _isGlobal- then _bindsIcrb ++ _bodyIcrb- else []) of- { _lhsOcrb ->- (case (__tup1) of- { (_nm2refNew,_) ->- (case (if _isGlobal- then _bodyIcre- else CR.Exp_Let _lhsIrefOffset (CR.nm2RefMpInverse _nm2refNew) (CR.crarrayFromList $ map snd _bindsIcrb) _bodyIcre) of- { _creBase ->- (case (_creBase) of- { _cre ->- (case (_cre) of- { _lhsOcre ->- (case ([]) of- { _creAppArgL ->- (case (_creAppArgL) of- { _lhsOcreAppArgL ->- (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of- { _creAppFun ->- (case (_creAppFun) of- { _lhsOcreAppFun ->- (case ([]) of- { _creLamArgL ->- (case (_creLamArgL) of- { _lhsOcreLamArgL ->- (case (_cre) of- { _creLamBody ->- (case (_creLamBody) of- { _lhsOcreLamBody ->- (case (panic "Core.ToCoreRun.CExpr.crse") of- { _crse ->- (case (_crse) of- { _lhsOcrse ->- (case (Nothing) of- { _lhsOmbFFIApp ->- (case (Nothing) of- { _lhsOmbLam ->- (case (Nothing) of- { _lhsOmbVar ->- (case (max _bindsIrefOffsetMax _bodyIrefOffsetMax) of- { _refOffsetMax ->- (case (_refOffsetMax) of- { _lhsOrefOffsetMax ->- (case (_bodyIstackDepth) of- { _lhsOstackDepth ->- (case (max _bindsIstackDepthMax _bodyIstackDepthMax) of- { _stackDepthMax ->- (case (_stackDepthMax) of- { _lhsOstackDepthMax ->- (case (panic "Core.ToCoreRun.CExpr.ref") of- { _vref ->- (case (_vref) of- { _lhsOvref ->- ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_Let_2)) of- { ( sem_CExpr_2) ->- ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_Let_1)) of- { ( sem_CExpr_1) ->- ( _lhsOwhatBelow,sem_CExpr_1) }) }) })-sem_CExpr_App :: T_CExpr ->- T_CBound ->- T_CExpr-sem_CExpr_App func_ arg_ =- (case (func_) of- { ( _funcIwhatBelow,func_1) ->- (case (maybe (ExprIsApp 1 _funcIwhatBelow) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _funcIwhatBelow) of- { _whatBelow ->- (case (_whatBelow) of- { _lhsOwhatBelow ->- (case ((let sem_CExpr_App_1 :: T_CExpr_1- sem_CExpr_App_1 =- (\ _lhsIlev- _lhsImodNr- _lhsIrefOffset- _lhsIwhatAbove ->- (case (_lhsIrefOffset) of- { _funcOrefOffset ->- (case (maybe (ExprIsApp 1 ExprIsOther) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _lhsIwhatAbove) of- { _whatAbove ->- (case (_whatAbove) of- { _funcOwhatAbove ->- (case (_lhsImodNr) of- { _funcOmodNr ->- (case (_lhsIlev) of- { _funcOlev ->- (case (func_1 _funcOlev _funcOmodNr _funcOrefOffset _funcOwhatAbove) of- { ( _funcInm2refGath,_funcIrefOffset,func_2) ->- (case (_funcIrefOffset) of- { _argOrefOffset ->- (case (_lhsImodNr) of- { _argOmodNr ->- (case (_lhsIlev) of- { _argOlev ->- (case (False) of- { _isGlobal ->- (case (_isGlobal) of- { _argOisGlobal ->- (case (hsnUnknown) of- { _argOnm ->- (case (EvalCtx_Thunk) of- { _argOevalCtx ->- (case (arg_ _argOevalCtx _argOisGlobal _argOlev _argOmodNr _argOnm _argOrefOffset) of- { ( _argInm2refGath,_argIrefOffset,arg_1) ->- (case (_funcInm2refGath `Map.union` _argInm2refGath) of- { _lhsOnm2refGath ->- (case (_argIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CExpr_App_2 :: T_CExpr_2- sem_CExpr_App_2 =- (\ _lhsIevalCtx- _lhsIisTopApp- _lhsIisTopTup- _lhsInm2ref- _lhsIopts- _lhsIstackDepth- _lhsItailCtx ->- (case (TailCtx_Plain) of- { _tailCtx ->- (case (_tailCtx) of- { _funcOtailCtx ->- (case (_lhsIstackDepth) of- { _funcOstackDepth ->- (case (_lhsIopts) of- { _funcOopts ->- (case (_lhsInm2ref) of- { _funcOnm2ref ->- (case (True) of- { _isTopTup ->- (case (_isTopTup) of- { _funcOisTopTup ->- (case (_lhsIevalCtx) of- { _funcOevalCtx ->- (case (False) of- { _funcOisTopApp ->- (case (func_2 _funcOevalCtx _funcOisTopApp _funcOisTopTup _funcOnm2ref _funcOopts _funcOstackDepth _funcOtailCtx) of- { ( _funcIappFunKind,_funcIcrb,_funcIcre,_funcIcreAppArgL,_funcIcreAppFun,_funcIcreLamArgL,_funcIcreLamBody,_funcIcrse,_funcImbFFIApp,_funcImbLam,_funcImbVar,_funcIrefOffsetMax,_funcIstackDepth,_funcIstackDepthMax,_funcIvref) ->- (case (_funcIappFunKind) of- { _lhsOappFunKind ->- (case ([]) of- { _lhsOcrb ->- (case (_lhsInm2ref) of- { _argOnm2ref ->- (case (_funcIcreAppFun) of- { _creAppFun ->- (case (if whatExprIsTup _funcIwhatBelow || whatExprIsFFI _funcIwhatBelow then _lhsIstackDepth else _funcIstackDepth) of- { _stackDepthFunc ->- (case (_stackDepthFunc) of- { _argOstackDepth ->- (case (_lhsIopts) of- { _argOopts ->- (case (acoreBindcategPlain) of- { _letBindingsCateg ->- (case (_letBindingsCateg) of- { _argOletBindingsCateg ->- (case (_isTopTup) of- { _argOisTopTup ->- (case (True) of- { _argOisTopApp ->- (case (arg_1 _argOisTopApp _argOisTopTup _argOletBindingsCateg _argOnm2ref _argOopts _argOstackDepth) of- { ( _argIcrb,_argIrefOffsetMax,_argIstackDepth,_argIstackDepthMax) ->- (case ((CR.exp2sexp $ snd $ head _argIcrb) : _funcIcreAppArgL) of- { _creAppArgL ->- (case (isNothing $ whatExprMbApp _lhsIwhatAbove) of- { _isTopApp' ->- (case (if _isTopApp'- then _creAppFun _lhsItailCtx $ CR.crarrayFromList $ reverse _creAppArgL- else CR.dbg "Core.ToCoreRun.CExpr.App.cre") of- { _creBase ->- (case (_creBase) of- { _cre ->- (case (_cre) of- { _lhsOcre ->- (case (_creAppArgL) of- { _lhsOcreAppArgL ->- (case (_creAppFun) of- { _lhsOcreAppFun ->- (case ([]) of- { _creLamArgL ->- (case (_creLamArgL) of- { _lhsOcreLamArgL ->- (case (_cre) of- { _creLamBody ->- (case (_creLamBody) of- { _lhsOcreLamBody ->- (case (panic "Core.ToCoreRun.CExpr.crse") of- { _crse ->- (case (_crse) of- { _lhsOcrse ->- (case (_funcImbFFIApp) of- { _lhsOmbFFIApp ->- (case (Nothing) of- { _lhsOmbLam ->- (case (Nothing) of- { _lhsOmbVar ->- (case (_funcIrefOffsetMax `max` _argIrefOffsetMax) of- { _lhsOrefOffsetMax ->- (case (if _isTopApp' then _lhsIstackDepth + 1 else _argIstackDepth) of- { _lhsOstackDepth ->- (case (max _argIstackDepth _argIstackDepthMax) of- { _stackDepthMax ->- (case (_stackDepthMax) of- { _lhsOstackDepthMax ->- (case (panic "Core.ToCoreRun.CExpr.ref") of- { _vref ->- (case (_vref) of- { _lhsOvref ->- ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_App_2)) of- { ( sem_CExpr_2) ->- ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_App_1)) of- { ( sem_CExpr_1) ->- ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) })-sem_CExpr_Lam :: T_CBind ->- T_CExpr ->- T_CExpr-sem_CExpr_Lam bind_ body_ =- (case (body_) of- { ( _bodyIwhatBelow,body_1) ->- (case (maybe (ExprIsLam 1 Nothing) (\a -> ExprIsLam (a + 1) Nothing) $ whatExprMbLam _bodyIwhatBelow) of- { _whatBelow ->- (case (_whatBelow) of- { _lhsOwhatBelow ->- (case ((let sem_CExpr_Lam_1 :: T_CExpr_1- sem_CExpr_Lam_1 =- (\ _lhsIlev- _lhsImodNr- _lhsIrefOffset- _lhsIwhatAbove ->- (case (case _lhsIwhatAbove of- ExprIsLam a mbnm -> ExprIsLam (a + 1) mbnm- ExprIsBind nm -> ExprIsLam 1 (Just nm)- _ -> ExprIsLam 1 Nothing) of- { _whatAbove ->- (case (_whatAbove) of- { _bodyOwhatAbove ->- (case (_lhsImodNr) of- { _bodyOmodNr ->- (case (not $ whatExprIsLam _lhsIwhatAbove) of- { _isTopLam ->- (case (if _isTopLam then _lhsIlev + 1 else _lhsIlev) of- { _lev ->- (case (_lev) of- { _bodyOlev ->- (case (if _isTopLam- then (0,1)- else (_lhsIrefOffset, _lhsIrefOffset + 1)) of- { __tup3 ->- (case (__tup3) of- { (_,_refOffsetBody) ->- (case (_refOffsetBody) of- { _bodyOrefOffset ->- (case (__tup3) of- { (_refOffset,_) ->- (case (body_1 _bodyOlev _bodyOmodNr _bodyOrefOffset _bodyOwhatAbove) of- { ( _bodyInm2refGath,_bodyIrefOffset,body_2) ->- (case (_refOffset) of- { _bindOrefOffset ->- (case (_lhsImodNr) of- { _bindOmodNr ->- (case (_lev) of- { _bindOlev ->- (case (False) of- { _isGlobal ->- (case (_isGlobal) of- { _bindOisGlobal ->- (case (bind_ _bindOisGlobal _bindOlev _bindOmodNr _bindOrefOffset) of- { ( _bindInm,_bindInm2refGath,_bindIrefOffset,bind_1) ->- (case (Map.insert _bindInm (CR.RRef_Loc _lev _refOffset) _bodyInm2refGath) of- { _nm2refNew ->- (case (if _isTopLam- then Map.empty- else _nm2refNew) of- { _lhsOnm2refGath ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CExpr_Lam_2 :: T_CExpr_2- sem_CExpr_Lam_2 =- (\ _lhsIevalCtx- _lhsIisTopApp- _lhsIisTopTup- _lhsInm2ref- _lhsIopts- _lhsIstackDepth- _lhsItailCtx ->- (case (AppFunKind_NoApp) of- { _lhsOappFunKind ->- (case ([]) of- { _lhsOcrb ->- (case (if _isTopLam- then _nm2refNew `Map.union` _lhsInm2ref- else _lhsInm2ref) of- { _nm2ref ->- (case (_nm2ref) of- { _bodyOnm2ref ->- (case (_lhsIopts) of- { _bodyOopts ->- (case (True) of- { _isTopTup ->- (case (_isTopTup) of- { _bodyOisTopTup ->- (case (True) of- { _isTopApp ->- (case (_isTopApp) of- { _bodyOisTopApp ->- (case (_lhsIevalCtx) of- { _bodyOevalCtx ->- (case (_refOffsetBody) of- { _bodyOstackDepth ->- (case (TailCtx_TailCall) of- { _bodyOtailCtx ->- (case (body_2 _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOnm2ref _bodyOopts _bodyOstackDepth _bodyOtailCtx) of- { ( _bodyIappFunKind,_bodyIcrb,_bodyIcre,_bodyIcreAppArgL,_bodyIcreAppFun,_bodyIcreLamArgL,_bodyIcreLamBody,_bodyIcrse,_bodyImbFFIApp,_bodyImbLam,_bodyImbVar,_bodyIrefOffsetMax,_bodyIstackDepth,_bodyIstackDepthMax,_bodyIvref) ->- (case (_bindInm : _bodyIcreLamArgL) of- { _creLamArgL ->- (case (max _bodyIstackDepth _bodyIstackDepthMax) of- { _stackDepthMax ->- (case (if _isTopLam- then CR.Exp_Lam (whatExprMbBind _lhsIwhatAbove) (length _creLamArgL) (_stackDepthMax) (CR.nm2RefMpInverse _nm2refNew) _bodyIcreLamBody- else CR.dbg "Core.ToCoreRun.CExpr.Lam.cre") of- { _creBase ->- (case (cseCtxWrap _lhsItailCtx _creBase) of- { _cre ->- (case (_cre) of- { _lhsOcre ->- (case ([]) of- { _creAppArgL ->- (case (_creAppArgL) of- { _lhsOcreAppArgL ->- (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of- { _creAppFun ->- (case (_creAppFun) of- { _lhsOcreAppFun ->- (case (_creLamArgL) of- { _lhsOcreLamArgL ->- (case (_bodyIcreLamBody) of- { _creLamBody ->- (case (_creLamBody) of- { _lhsOcreLamBody ->- (case (panic "Core.ToCoreRun.CExpr.crse") of- { _crse ->- (case (_crse) of- { _lhsOcrse ->- (case (Nothing) of- { _lhsOmbFFIApp ->- (case (_bindInm) of- { _argNm ->- (case (Just $ maybe [_argNm] (_argNm:) _bodyImbLam) of- { _lhsOmbLam ->- (case (Nothing) of- { _lhsOmbVar ->- (case (max _bodyIrefOffset _bodyIrefOffsetMax) of- { _refOffsetMax ->- (case (_refOffsetMax) of- { _lhsOrefOffsetMax ->- (case (_bodyIstackDepth) of- { _lhsOstackDepth ->- (case (_stackDepthMax) of- { _lhsOstackDepthMax ->- (case (panic "Core.ToCoreRun.CExpr.ref") of- { _vref ->- (case (_vref) of- { _lhsOvref ->- ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_Lam_2)) of- { ( sem_CExpr_2) ->- ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_Lam_1)) of- { ( sem_CExpr_1) ->- ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) })-sem_CExpr_Case :: T_CExpr ->- T_CAltL ->- T_CExpr ->- T_CExpr-sem_CExpr_Case expr_ alts_ dflt_ =- (case (ExprIsOther) of- { _whatBelow ->- (case (_whatBelow) of- { _lhsOwhatBelow ->- (case ((let sem_CExpr_Case_1 :: T_CExpr_1- sem_CExpr_Case_1 =- (\ _lhsIlev- _lhsImodNr- _lhsIrefOffset- _lhsIwhatAbove ->- (case (ExprIsOther) of- { _whatAbove ->- (case (_whatAbove) of- { _dfltOwhatAbove ->- (case (_lhsIrefOffset) of- { _exprOrefOffset ->- (case (expr_) of- { ( _exprIwhatBelow,expr_1) ->- (case (_whatAbove) of- { _exprOwhatAbove ->- (case (_lhsImodNr) of- { _exprOmodNr ->- (case (_lhsIlev) of- { _exprOlev ->- (case (expr_1 _exprOlev _exprOmodNr _exprOrefOffset _exprOwhatAbove) of- { ( _exprInm2refGath,_exprIrefOffset,expr_2) ->- (case (_exprIrefOffset) of- { _altsOrefOffset ->- (case (alts_ _altsOrefOffset) of- { ( _altsIrefOffset,alts_1) ->- (case (_altsIrefOffset) of- { _dfltOrefOffset ->- (case (_lhsImodNr) of- { _dfltOmodNr ->- (case (_lhsIlev) of- { _dfltOlev ->- (case (dflt_) of- { ( _dfltIwhatBelow,dflt_1) ->- (case (dflt_1 _dfltOlev _dfltOmodNr _dfltOrefOffset _dfltOwhatAbove) of- { ( _dfltInm2refGath,_dfltIrefOffset,dflt_2) ->- (case (_exprInm2refGath `Map.union` _dfltInm2refGath) of- { _lhsOnm2refGath ->- (case (_dfltIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CExpr_Case_2 :: T_CExpr_2- sem_CExpr_Case_2 =- (\ _lhsIevalCtx- _lhsIisTopApp- _lhsIisTopTup- _lhsInm2ref- _lhsIopts- _lhsIstackDepth- _lhsItailCtx ->- (case (AppFunKind_NoApp) of- { _lhsOappFunKind ->- (case ([]) of- { _lhsOcrb ->- (case (_lhsItailCtx) of- { _altsOtailCtx ->- (case (_lhsInm2ref) of- { _altsOnm2ref ->- (case (_lhsImodNr) of- { _altsOmodNr ->- (case (_lhsIlev) of- { _altsOlev ->- (case (_lhsInm2ref) of- { _exprOnm2ref ->- (case (maybe CR.noRRef (\n -> maybe (CR.RRef_Dbg n) id $ Map.lookup n _lhsInm2ref) $ whatExprMbVar _exprIwhatBelow) of- { _altsOscrutRef ->- (case (_lhsIstackDepth) of- { _altsOstackDepth ->- (case (_lhsIopts) of- { _altsOopts ->- (case (_lhsIevalCtx) of- { _altsOevalCtx ->- (case (alts_1 _altsOevalCtx _altsOlev _altsOmodNr _altsOnm2ref _altsOopts _altsOscrutRef _altsOstackDepth _altsOtailCtx) of- { ( _altsIcra,_altsIrefOffsetMax,_altsIstackDepth,_altsIstackDepthMax) ->- (case (_lhsIstackDepth) of- { _exprOstackDepth ->- (case (_lhsIopts) of- { _exprOopts ->- (case (True) of- { _isTopTup ->- (case (_isTopTup) of- { _exprOisTopTup ->- (case (True) of- { _isTopApp ->- (case (_isTopApp) of- { _exprOisTopApp ->- (case (_lhsIevalCtx) of- { _exprOevalCtx ->- (case (TailCtx_Plain) of- { _exprOtailCtx ->- (case (expr_2 _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of- { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax,_exprIvref) ->- (case (CR.Exp_Case (CR.mkVar' $ CR.RRef_Tag _exprIvref) $ CR.crarrayFromList _altsIcra) of- { _creBase ->- (case (_creBase) of- { _cre ->- (case (_cre) of- { _lhsOcre ->- (case ([]) of- { _creAppArgL ->- (case (_creAppArgL) of- { _lhsOcreAppArgL ->- (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of- { _creAppFun ->- (case (_creAppFun) of- { _lhsOcreAppFun ->- (case ([]) of- { _creLamArgL ->- (case (_creLamArgL) of- { _lhsOcreLamArgL ->- (case (_cre) of- { _creLamBody ->- (case (_creLamBody) of- { _lhsOcreLamBody ->- (case (panic "Core.ToCoreRun.CExpr.crse") of- { _crse ->- (case (_crse) of- { _lhsOcrse ->- (case (Nothing) of- { _lhsOmbFFIApp ->- (case (Nothing) of- { _lhsOmbLam ->- (case (Nothing) of- { _lhsOmbVar ->- (case (_lhsItailCtx) of- { _dfltOtailCtx ->- (case (_altsIstackDepth) of- { _dfltOstackDepth ->- (case (_lhsIopts) of- { _dfltOopts ->- (case (_lhsInm2ref) of- { _dfltOnm2ref ->- (case (_isTopTup) of- { _dfltOisTopTup ->- (case (_isTopApp) of- { _dfltOisTopApp ->- (case (_lhsIevalCtx) of- { _dfltOevalCtx ->- (case (dflt_2 _dfltOevalCtx _dfltOisTopApp _dfltOisTopTup _dfltOnm2ref _dfltOopts _dfltOstackDepth _dfltOtailCtx) of- { ( _dfltIappFunKind,_dfltIcrb,_dfltIcre,_dfltIcreAppArgL,_dfltIcreAppFun,_dfltIcreLamArgL,_dfltIcreLamBody,_dfltIcrse,_dfltImbFFIApp,_dfltImbLam,_dfltImbVar,_dfltIrefOffsetMax,_dfltIstackDepth,_dfltIstackDepthMax,_dfltIvref) ->- (case (_exprIrefOffsetMax `max` _altsIrefOffsetMax `max` _dfltIrefOffsetMax) of- { _lhsOrefOffsetMax ->- (case (_lhsIstackDepth + 1) of- { _stackDepthHere ->- (case (_stackDepthHere) of- { _lhsOstackDepth ->- (case (max _exprIstackDepthMax _altsIstackDepthMax) of- { _stackDepthMax ->- (case (_stackDepthMax) of- { _lhsOstackDepthMax ->- (case (panic "Core.ToCoreRun.CExpr.ref") of- { _vref ->- (case (_vref) of- { _lhsOvref ->- ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_Case_2)) of- { ( sem_CExpr_2) ->- ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_Case_1)) of- { ( sem_CExpr_1) ->- ( _lhsOwhatBelow,sem_CExpr_1) }) }) })-sem_CExpr_CaseAltFail :: CaseAltFailReason ->- T_CExpr ->- T_CExpr-sem_CExpr_CaseAltFail failReason_ errorExpr_ =- (case (errorExpr_) of- { ( _errorExprIwhatBelow,errorExpr_1) ->- (case (_errorExprIwhatBelow) of- { _lhsOwhatBelow ->- (case ((let sem_CExpr_CaseAltFail_1 :: T_CExpr_1- sem_CExpr_CaseAltFail_1 =- (\ _lhsIlev- _lhsImodNr- _lhsIrefOffset- _lhsIwhatAbove ->- (case (ExprIsOther) of- { _whatAbove ->- (case (_whatAbove) of- { _errorExprOwhatAbove ->- (case (_lhsIrefOffset) of- { _errorExprOrefOffset ->- (case (_lhsImodNr) of- { _errorExprOmodNr ->- (case (_lhsIlev) of- { _errorExprOlev ->- (case (errorExpr_1 _errorExprOlev _errorExprOmodNr _errorExprOrefOffset _errorExprOwhatAbove) of- { ( _errorExprInm2refGath,_errorExprIrefOffset,errorExpr_2) ->- (case (_errorExprInm2refGath) of- { _lhsOnm2refGath ->- (case (_errorExprIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CExpr_CaseAltFail_2 :: T_CExpr_2- sem_CExpr_CaseAltFail_2 =- (\ _lhsIevalCtx- _lhsIisTopApp- _lhsIisTopTup- _lhsInm2ref- _lhsIopts- _lhsIstackDepth- _lhsItailCtx ->- (case (_lhsItailCtx) of- { _errorExprOtailCtx ->- (case (_lhsIstackDepth) of- { _errorExprOstackDepth ->- (case (_lhsIopts) of- { _errorExprOopts ->- (case (_lhsInm2ref) of- { _errorExprOnm2ref ->- (case (True) of- { _isTopTup ->- (case (_isTopTup) of- { _errorExprOisTopTup ->- (case (True) of- { _isTopApp ->- (case (_isTopApp) of- { _errorExprOisTopApp ->- (case (_lhsIevalCtx) of- { _errorExprOevalCtx ->- (case (errorExpr_2 _errorExprOevalCtx _errorExprOisTopApp _errorExprOisTopTup _errorExprOnm2ref _errorExprOopts _errorExprOstackDepth _errorExprOtailCtx) of- { ( _errorExprIappFunKind,_errorExprIcrb,_errorExprIcre,_errorExprIcreAppArgL,_errorExprIcreAppFun,_errorExprIcreLamArgL,_errorExprIcreLamBody,_errorExprIcrse,_errorExprImbFFIApp,_errorExprImbLam,_errorExprImbVar,_errorExprIrefOffsetMax,_errorExprIstackDepth,_errorExprIstackDepthMax,_errorExprIvref) ->- (case (_errorExprIappFunKind) of- { _lhsOappFunKind ->- (case ([]) of- { _lhsOcrb ->- (case (CR.dbg "Core.ToCoreRun.CExpr.cre") of- { _creBase ->- (case (cseCtxWrap _lhsItailCtx _creBase) of- { _cre ->- (case (_cre) of- { _lhsOcre ->- (case ([]) of- { _creAppArgL ->- (case (_creAppArgL) of- { _lhsOcreAppArgL ->- (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of- { _creAppFun ->- (case (_creAppFun) of- { _lhsOcreAppFun ->- (case ([]) of- { _creLamArgL ->- (case (_creLamArgL) of- { _lhsOcreLamArgL ->- (case (_cre) of- { _creLamBody ->- (case (_creLamBody) of- { _lhsOcreLamBody ->- (case (panic "Core.ToCoreRun.CExpr.crse") of- { _crse ->- (case (_crse) of- { _lhsOcrse ->- (case (Nothing) of- { _lhsOmbFFIApp ->- (case (_errorExprImbLam) of- { _lhsOmbLam ->- (case (_errorExprImbVar) of- { _lhsOmbVar ->- (case (_errorExprIrefOffsetMax) of- { _lhsOrefOffsetMax ->- (case (_lhsIstackDepth + 1) of- { _stackDepthHere ->- (case (_stackDepthHere) of- { _lhsOstackDepth ->- (case (_stackDepthHere) of- { _lhsOstackDepthMax ->- (case (panic "Core.ToCoreRun.CExpr.ref") of- { _vref ->- (case (_vref) of- { _lhsOvref ->- ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_CaseAltFail_2)) of- { ( sem_CExpr_2) ->- ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }))- in sem_CExpr_CaseAltFail_1)) of- { ( sem_CExpr_1) ->- ( _lhsOwhatBelow,sem_CExpr_1) }) }) })-sem_CExpr_TupDel :: T_CExpr ->- CTag ->- HsName ->- T_CExpr ->- T_CExpr-sem_CExpr_TupDel expr_ tag_ nm_ offset_ =- (case (ExprIsOther) of- { _whatBelow ->- (case (_whatBelow) of- { _lhsOwhatBelow ->- (case ((let sem_CExpr_TupDel_1 :: T_CExpr_1- sem_CExpr_TupDel_1 =- (\ _lhsIlev- _lhsImodNr- _lhsIrefOffset- _lhsIwhatAbove ->- (case (ExprIsOther) of- { _whatAbove ->- (case (_whatAbove) of- { _offsetOwhatAbove ->- (case (_lhsIrefOffset) of- { _exprOrefOffset ->- (case (expr_) of- { ( _exprIwhatBelow,expr_1) ->- (case (_whatAbove) of- { _exprOwhatAbove ->- (case (_lhsImodNr) of- { _exprOmodNr ->- (case (_lhsIlev) of- { _exprOlev ->- (case (expr_1 _exprOlev _exprOmodNr _exprOrefOffset _exprOwhatAbove) of- { ( _exprInm2refGath,_exprIrefOffset,expr_2) ->- (case (_exprIrefOffset) of- { _offsetOrefOffset ->- (case (_lhsImodNr) of- { _offsetOmodNr ->- (case (_lhsIlev) of- { _offsetOlev ->- (case (offset_) of- { ( _offsetIwhatBelow,offset_1) ->- (case (offset_1 _offsetOlev _offsetOmodNr _offsetOrefOffset _offsetOwhatAbove) of- { ( _offsetInm2refGath,_offsetIrefOffset,offset_2) ->- (case (_exprInm2refGath `Map.union` _offsetInm2refGath) of- { _lhsOnm2refGath ->- (case (_offsetIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CExpr_TupDel_2 :: T_CExpr_2- sem_CExpr_TupDel_2 =- (\ _lhsIevalCtx- _lhsIisTopApp- _lhsIisTopTup- _lhsInm2ref- _lhsIopts- _lhsIstackDepth- _lhsItailCtx ->- (case (AppFunKind_NoApp) of- { _lhsOappFunKind ->- (case ([]) of- { _lhsOcrb ->- (case (CR.dbg "Core.ToCoreRun.CExpr.cre") of- { _creBase ->- (case (cseCtxWrap _lhsItailCtx _creBase) of- { _cre ->- (case (_cre) of- { _lhsOcre ->- (case ([]) of- { _creAppArgL ->- (case (_creAppArgL) of- { _lhsOcreAppArgL ->- (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of- { _creAppFun ->- (case (_creAppFun) of- { _lhsOcreAppFun ->- (case ([]) of- { _creLamArgL ->- (case (_creLamArgL) of- { _lhsOcreLamArgL ->- (case (_cre) of- { _creLamBody ->- (case (_creLamBody) of- { _lhsOcreLamBody ->- (case (panic "Core.ToCoreRun.CExpr.crse") of- { _crse ->- (case (_crse) of- { _lhsOcrse ->- (case (Nothing) of- { _lhsOmbFFIApp ->- (case (Nothing) of- { _lhsOmbLam ->- (case (Nothing) of- { _lhsOmbVar ->- (case (_lhsItailCtx) of- { _offsetOtailCtx ->- (case (_lhsIstackDepth) of- { _exprOstackDepth ->- (case (_lhsItailCtx) of- { _exprOtailCtx ->- (case (_lhsIopts) of- { _exprOopts ->- (case (_lhsInm2ref) of- { _exprOnm2ref ->- (case (True) of- { _isTopApp ->- (case (_isTopApp) of- { _exprOisTopApp ->- (case (_lhsIevalCtx) of- { _exprOevalCtx ->- (case (False) of- { _exprOisTopTup ->- (case (expr_2 _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of- { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax,_exprIvref) ->- (case (_exprIstackDepth) of- { _offsetOstackDepth ->- (case (_lhsIopts) of- { _offsetOopts ->- (case (_lhsInm2ref) of- { _offsetOnm2ref ->- (case (True) of- { _isTopTup ->- (case (_isTopTup) of- { _offsetOisTopTup ->- (case (_isTopApp) of- { _offsetOisTopApp ->- (case (_lhsIevalCtx) of- { _offsetOevalCtx ->- (case (offset_2 _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOnm2ref _offsetOopts _offsetOstackDepth _offsetOtailCtx) of- { ( _offsetIappFunKind,_offsetIcrb,_offsetIcre,_offsetIcreAppArgL,_offsetIcreAppFun,_offsetIcreLamArgL,_offsetIcreLamBody,_offsetIcrse,_offsetImbFFIApp,_offsetImbLam,_offsetImbVar,_offsetIrefOffsetMax,_offsetIstackDepth,_offsetIstackDepthMax,_offsetIvref) ->- (case (_exprIrefOffsetMax `max` _offsetIrefOffsetMax) of- { _lhsOrefOffsetMax ->- (case (_lhsIstackDepth + 1) of- { _stackDepthHere ->- (case (_stackDepthHere) of- { _lhsOstackDepth ->- (case (_stackDepthHere) of- { _lhsOstackDepthMax ->- (case (panic "Core.ToCoreRun.CExpr.ref") of- { _vref ->- (case (_vref) of- { _lhsOvref ->- ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_TupDel_2)) of- { ( sem_CExpr_2) ->- ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_TupDel_1)) of- { ( sem_CExpr_1) ->- ( _lhsOwhatBelow,sem_CExpr_1) }) }) })-sem_CExpr_TupIns :: T_CExpr ->- CTag ->- HsName ->- T_CExpr ->- T_CExpr ->- T_CExpr-sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ =- (case (ExprIsOther) of- { _whatBelow ->- (case (_whatBelow) of- { _lhsOwhatBelow ->- (case ((let sem_CExpr_TupIns_1 :: T_CExpr_1- sem_CExpr_TupIns_1 =- (\ _lhsIlev- _lhsImodNr- _lhsIrefOffset- _lhsIwhatAbove ->- (case (ExprIsOther) of- { _whatAbove ->- (case (_whatAbove) of- { _fldExprOwhatAbove ->- (case (_lhsIrefOffset) of- { _exprOrefOffset ->- (case (expr_) of- { ( _exprIwhatBelow,expr_1) ->- (case (_whatAbove) of- { _exprOwhatAbove ->- (case (_lhsImodNr) of- { _exprOmodNr ->- (case (_lhsIlev) of- { _exprOlev ->- (case (expr_1 _exprOlev _exprOmodNr _exprOrefOffset _exprOwhatAbove) of- { ( _exprInm2refGath,_exprIrefOffset,expr_2) ->- (case (_exprIrefOffset) of- { _offsetOrefOffset ->- (case (offset_) of- { ( _offsetIwhatBelow,offset_1) ->- (case (_whatAbove) of- { _offsetOwhatAbove ->- (case (_lhsImodNr) of- { _offsetOmodNr ->- (case (_lhsIlev) of- { _offsetOlev ->- (case (offset_1 _offsetOlev _offsetOmodNr _offsetOrefOffset _offsetOwhatAbove) of- { ( _offsetInm2refGath,_offsetIrefOffset,offset_2) ->- (case (_offsetIrefOffset) of- { _fldExprOrefOffset ->- (case (_lhsImodNr) of- { _fldExprOmodNr ->- (case (_lhsIlev) of- { _fldExprOlev ->- (case (fldExpr_) of- { ( _fldExprIwhatBelow,fldExpr_1) ->- (case (fldExpr_1 _fldExprOlev _fldExprOmodNr _fldExprOrefOffset _fldExprOwhatAbove) of- { ( _fldExprInm2refGath,_fldExprIrefOffset,fldExpr_2) ->- (case (_exprInm2refGath `Map.union` _offsetInm2refGath `Map.union` _fldExprInm2refGath) of- { _lhsOnm2refGath ->- (case (_fldExprIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CExpr_TupIns_2 :: T_CExpr_2- sem_CExpr_TupIns_2 =- (\ _lhsIevalCtx- _lhsIisTopApp- _lhsIisTopTup- _lhsInm2ref- _lhsIopts- _lhsIstackDepth- _lhsItailCtx ->- (case (AppFunKind_NoApp) of- { _lhsOappFunKind ->- (case ([]) of- { _lhsOcrb ->- (case (CR.dbg "Core.ToCoreRun.CExpr.cre") of- { _creBase ->- (case (cseCtxWrap _lhsItailCtx _creBase) of- { _cre ->- (case (_cre) of- { _lhsOcre ->- (case ([]) of- { _creAppArgL ->- (case (_creAppArgL) of- { _lhsOcreAppArgL ->- (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of- { _creAppFun ->- (case (_creAppFun) of- { _lhsOcreAppFun ->- (case ([]) of- { _creLamArgL ->- (case (_creLamArgL) of- { _lhsOcreLamArgL ->- (case (_cre) of- { _creLamBody ->- (case (_creLamBody) of- { _lhsOcreLamBody ->- (case (panic "Core.ToCoreRun.CExpr.crse") of- { _crse ->- (case (_crse) of- { _lhsOcrse ->- (case (Nothing) of- { _lhsOmbFFIApp ->- (case (Nothing) of- { _lhsOmbLam ->- (case (Nothing) of- { _lhsOmbVar ->- (case (_lhsItailCtx) of- { _fldExprOtailCtx ->- (case (_lhsIstackDepth) of- { _exprOstackDepth ->- (case (_lhsItailCtx) of- { _exprOtailCtx ->- (case (_lhsIopts) of- { _exprOopts ->- (case (_lhsInm2ref) of- { _exprOnm2ref ->- (case (True) of- { _isTopApp ->- (case (_isTopApp) of- { _exprOisTopApp ->- (case (_lhsIevalCtx) of- { _exprOevalCtx ->- (case (False) of- { _exprOisTopTup ->- (case (expr_2 _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of- { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax,_exprIvref) ->- (case (_exprIstackDepth) of- { _offsetOstackDepth ->- (case (_lhsItailCtx) of- { _offsetOtailCtx ->- (case (_lhsIopts) of- { _offsetOopts ->- (case (_lhsInm2ref) of- { _offsetOnm2ref ->- (case (True) of- { _isTopTup ->- (case (_isTopTup) of- { _offsetOisTopTup ->- (case (_isTopApp) of- { _offsetOisTopApp ->- (case (_lhsIevalCtx) of- { _offsetOevalCtx ->- (case (offset_2 _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOnm2ref _offsetOopts _offsetOstackDepth _offsetOtailCtx) of- { ( _offsetIappFunKind,_offsetIcrb,_offsetIcre,_offsetIcreAppArgL,_offsetIcreAppFun,_offsetIcreLamArgL,_offsetIcreLamBody,_offsetIcrse,_offsetImbFFIApp,_offsetImbLam,_offsetImbVar,_offsetIrefOffsetMax,_offsetIstackDepth,_offsetIstackDepthMax,_offsetIvref) ->- (case (_offsetIstackDepth) of- { _fldExprOstackDepth ->- (case (_lhsIopts) of- { _fldExprOopts ->- (case (_lhsInm2ref) of- { _fldExprOnm2ref ->- (case (_isTopTup) of- { _fldExprOisTopTup ->- (case (_isTopApp) of- { _fldExprOisTopApp ->- (case (_lhsIevalCtx) of- { _fldExprOevalCtx ->- (case (fldExpr_2 _fldExprOevalCtx _fldExprOisTopApp _fldExprOisTopTup _fldExprOnm2ref _fldExprOopts _fldExprOstackDepth _fldExprOtailCtx) of- { ( _fldExprIappFunKind,_fldExprIcrb,_fldExprIcre,_fldExprIcreAppArgL,_fldExprIcreAppFun,_fldExprIcreLamArgL,_fldExprIcreLamBody,_fldExprIcrse,_fldExprImbFFIApp,_fldExprImbLam,_fldExprImbVar,_fldExprIrefOffsetMax,_fldExprIstackDepth,_fldExprIstackDepthMax,_fldExprIvref) ->- (case (_exprIrefOffsetMax `max` _offsetIrefOffsetMax `max` _fldExprIrefOffsetMax) of- { _lhsOrefOffsetMax ->- (case (_lhsIstackDepth + 1) of- { _stackDepthHere ->- (case (_stackDepthHere) of- { _lhsOstackDepth ->- (case (_stackDepthHere) of- { _lhsOstackDepthMax ->- (case (panic "Core.ToCoreRun.CExpr.ref") of- { _vref ->- (case (_vref) of- { _lhsOvref ->- ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_TupIns_2)) of- { ( sem_CExpr_2) ->- ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_TupIns_1)) of- { ( sem_CExpr_1) ->- ( _lhsOwhatBelow,sem_CExpr_1) }) }) })-sem_CExpr_TupUpd :: T_CExpr ->- CTag ->- HsName ->- T_CExpr ->- T_CExpr ->- T_CExpr-sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ =- (case (ExprIsOther) of- { _whatBelow ->- (case (_whatBelow) of- { _lhsOwhatBelow ->- (case ((let sem_CExpr_TupUpd_1 :: T_CExpr_1- sem_CExpr_TupUpd_1 =- (\ _lhsIlev- _lhsImodNr- _lhsIrefOffset- _lhsIwhatAbove ->- (case (ExprIsOther) of- { _whatAbove ->- (case (_whatAbove) of- { _fldExprOwhatAbove ->- (case (_lhsIrefOffset) of- { _exprOrefOffset ->- (case (expr_) of- { ( _exprIwhatBelow,expr_1) ->- (case (_whatAbove) of- { _exprOwhatAbove ->- (case (_lhsImodNr) of- { _exprOmodNr ->- (case (_lhsIlev) of- { _exprOlev ->- (case (expr_1 _exprOlev _exprOmodNr _exprOrefOffset _exprOwhatAbove) of- { ( _exprInm2refGath,_exprIrefOffset,expr_2) ->- (case (_exprIrefOffset) of- { _offsetOrefOffset ->- (case (offset_) of- { ( _offsetIwhatBelow,offset_1) ->- (case (_whatAbove) of- { _offsetOwhatAbove ->- (case (_lhsImodNr) of- { _offsetOmodNr ->- (case (_lhsIlev) of- { _offsetOlev ->- (case (offset_1 _offsetOlev _offsetOmodNr _offsetOrefOffset _offsetOwhatAbove) of- { ( _offsetInm2refGath,_offsetIrefOffset,offset_2) ->- (case (_offsetIrefOffset) of- { _fldExprOrefOffset ->- (case (_lhsImodNr) of- { _fldExprOmodNr ->- (case (_lhsIlev) of- { _fldExprOlev ->- (case (fldExpr_) of- { ( _fldExprIwhatBelow,fldExpr_1) ->- (case (fldExpr_1 _fldExprOlev _fldExprOmodNr _fldExprOrefOffset _fldExprOwhatAbove) of- { ( _fldExprInm2refGath,_fldExprIrefOffset,fldExpr_2) ->- (case (_exprInm2refGath `Map.union` _offsetInm2refGath `Map.union` _fldExprInm2refGath) of- { _lhsOnm2refGath ->- (case (_fldExprIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CExpr_TupUpd_2 :: T_CExpr_2- sem_CExpr_TupUpd_2 =- (\ _lhsIevalCtx- _lhsIisTopApp- _lhsIisTopTup- _lhsInm2ref- _lhsIopts- _lhsIstackDepth- _lhsItailCtx ->- (case (AppFunKind_NoApp) of- { _lhsOappFunKind ->- (case ([]) of- { _lhsOcrb ->- (case (CR.dbg "Core.ToCoreRun.CExpr.cre") of- { _creBase ->- (case (cseCtxWrap _lhsItailCtx _creBase) of- { _cre ->- (case (_cre) of- { _lhsOcre ->- (case ([]) of- { _creAppArgL ->- (case (_creAppArgL) of- { _lhsOcreAppArgL ->- (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of- { _creAppFun ->- (case (_creAppFun) of- { _lhsOcreAppFun ->- (case ([]) of- { _creLamArgL ->- (case (_creLamArgL) of- { _lhsOcreLamArgL ->- (case (_cre) of- { _creLamBody ->- (case (_creLamBody) of- { _lhsOcreLamBody ->- (case (panic "Core.ToCoreRun.CExpr.crse") of- { _crse ->- (case (_crse) of- { _lhsOcrse ->- (case (Nothing) of- { _lhsOmbFFIApp ->- (case (Nothing) of- { _lhsOmbLam ->- (case (Nothing) of- { _lhsOmbVar ->- (case (_lhsItailCtx) of- { _fldExprOtailCtx ->- (case (_lhsIstackDepth) of- { _exprOstackDepth ->- (case (_lhsItailCtx) of- { _exprOtailCtx ->- (case (_lhsIopts) of- { _exprOopts ->- (case (_lhsInm2ref) of- { _exprOnm2ref ->- (case (True) of- { _isTopApp ->- (case (_isTopApp) of- { _exprOisTopApp ->- (case (_lhsIevalCtx) of- { _exprOevalCtx ->- (case (False) of- { _exprOisTopTup ->- (case (expr_2 _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of- { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax,_exprIvref) ->- (case (_exprIstackDepth) of- { _offsetOstackDepth ->- (case (_lhsItailCtx) of- { _offsetOtailCtx ->- (case (_lhsIopts) of- { _offsetOopts ->- (case (_lhsInm2ref) of- { _offsetOnm2ref ->- (case (True) of- { _isTopTup ->- (case (_isTopTup) of- { _offsetOisTopTup ->- (case (_isTopApp) of- { _offsetOisTopApp ->- (case (_lhsIevalCtx) of- { _offsetOevalCtx ->- (case (offset_2 _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOnm2ref _offsetOopts _offsetOstackDepth _offsetOtailCtx) of- { ( _offsetIappFunKind,_offsetIcrb,_offsetIcre,_offsetIcreAppArgL,_offsetIcreAppFun,_offsetIcreLamArgL,_offsetIcreLamBody,_offsetIcrse,_offsetImbFFIApp,_offsetImbLam,_offsetImbVar,_offsetIrefOffsetMax,_offsetIstackDepth,_offsetIstackDepthMax,_offsetIvref) ->- (case (_offsetIstackDepth) of- { _fldExprOstackDepth ->- (case (_lhsIopts) of- { _fldExprOopts ->- (case (_lhsInm2ref) of- { _fldExprOnm2ref ->- (case (_isTopTup) of- { _fldExprOisTopTup ->- (case (_isTopApp) of- { _fldExprOisTopApp ->- (case (_lhsIevalCtx) of- { _fldExprOevalCtx ->- (case (fldExpr_2 _fldExprOevalCtx _fldExprOisTopApp _fldExprOisTopTup _fldExprOnm2ref _fldExprOopts _fldExprOstackDepth _fldExprOtailCtx) of- { ( _fldExprIappFunKind,_fldExprIcrb,_fldExprIcre,_fldExprIcreAppArgL,_fldExprIcreAppFun,_fldExprIcreLamArgL,_fldExprIcreLamBody,_fldExprIcrse,_fldExprImbFFIApp,_fldExprImbLam,_fldExprImbVar,_fldExprIrefOffsetMax,_fldExprIstackDepth,_fldExprIstackDepthMax,_fldExprIvref) ->- (case (_exprIrefOffsetMax `max` _offsetIrefOffsetMax `max` _fldExprIrefOffsetMax) of- { _lhsOrefOffsetMax ->- (case (_lhsIstackDepth + 1) of- { _stackDepthHere ->- (case (_stackDepthHere) of- { _lhsOstackDepth ->- (case (_stackDepthHere) of- { _lhsOstackDepthMax ->- (case (panic "Core.ToCoreRun.CExpr.ref") of- { _vref ->- (case (_vref) of- { _lhsOvref ->- ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_TupUpd_2)) of- { ( sem_CExpr_2) ->- ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_TupUpd_1)) of- { ( sem_CExpr_1) ->- ( _lhsOwhatBelow,sem_CExpr_1) }) }) })-sem_CExpr_FFI :: FFIWay ->- String ->- ForeignEnt ->- Ty ->- T_CExpr-sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ =- (case (ExprIsFFI) of- { _whatBelow ->- (case (_whatBelow) of- { _lhsOwhatBelow ->- (case ((let sem_CExpr_FFI_1 :: T_CExpr_1- sem_CExpr_FFI_1 =- (\ _lhsIlev- _lhsImodNr- _lhsIrefOffset- _lhsIwhatAbove ->- (case (Map.empty) of- { _lhsOnm2refGath ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CExpr_FFI_2 :: T_CExpr_2- sem_CExpr_FFI_2 =- (\ _lhsIevalCtx- _lhsIisTopApp- _lhsIisTopTup- _lhsInm2ref- _lhsIopts- _lhsIstackDepth- _lhsItailCtx ->- (case (AppFunKind_FFI) of- { _lhsOappFunKind ->- (case ([]) of- { _lhsOcrb ->- (case (foreignEntExtract impEnt_) of- { _foreignEntInfo ->- (case (forextractMbEnt _foreignEntInfo) of- { _creEntMb ->- (case (\as -> maybe (CR.dbg $ "Core.ToCoreRun.CExpr.FFI.cre: " ++ show _foreignEntInfo) (\ent -> CR.mkFFI' ent as) _creEntMb) of- { _creMk ->- (case (_creMk CR.emptyCRArray) of- { _creBase ->- (case (_creBase) of- { _cre ->- (case (_cre) of- { _lhsOcre ->- (case ([]) of- { _creAppArgL ->- (case (_creAppArgL) of- { _lhsOcreAppArgL ->- (case (\_ -> cseCtxWrap TailCtx_Plain . _creMk) of- { _creAppFun ->- (case (_creAppFun) of- { _lhsOcreAppFun ->- (case ([]) of- { _creLamArgL ->- (case (_creLamArgL) of- { _lhsOcreLamArgL ->- (case (_cre) of- { _creLamBody ->- (case (_creLamBody) of- { _lhsOcreLamBody ->- (case (panic "Core.ToCoreRun.CExpr.crse") of- { _crse ->- (case (_crse) of- { _lhsOcrse ->- (case (maybe Nothing lookupPrimNeedsEval $ forextractMbEnt _foreignEntInfo) of- { _mbPrimNeedEval ->- (case (maybe False primResNeedEval _mbPrimNeedEval) of- { _primResNeedsEval ->- (case (appUnArr ty_) of- { _argTyLresTy ->- (case (snd _argTyLresTy) of- { _resTy ->- (case (fst _argTyLresTy) of- { _argTyL ->- (case (Just ( _resTy- , _primResNeedsEval- , callconv_- , impEnt_- , _argTyL- )) of- { _lhsOmbFFIApp ->- (case (Nothing) of- { _lhsOmbLam ->- (case (Nothing) of- { _lhsOmbVar ->- (case (0) of- { _lhsOrefOffsetMax ->- (case (_lhsIstackDepth + 1) of- { _stackDepthHere ->- (case (_stackDepthHere) of- { _lhsOstackDepth ->- (case (_stackDepthHere) of- { _lhsOstackDepthMax ->- (case (panic "Core.ToCoreRun.CExpr.ref") of- { _vref ->- (case (_vref) of- { _lhsOvref ->- ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_FFI_2)) of- { ( sem_CExpr_2) ->- ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }))- in sem_CExpr_FFI_1)) of- { ( sem_CExpr_1) ->- ( _lhsOwhatBelow,sem_CExpr_1) }) }) })-sem_CExpr_Dbg :: String ->- T_CExpr-sem_CExpr_Dbg info_ =- (case (ExprIsOther) of- { _whatBelow ->- (case (_whatBelow) of- { _lhsOwhatBelow ->- (case ((let sem_CExpr_Dbg_1 :: T_CExpr_1- sem_CExpr_Dbg_1 =- (\ _lhsIlev- _lhsImodNr- _lhsIrefOffset- _lhsIwhatAbove ->- (case (Map.empty) of- { _lhsOnm2refGath ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CExpr_Dbg_2 :: T_CExpr_2- sem_CExpr_Dbg_2 =- (\ _lhsIevalCtx- _lhsIisTopApp- _lhsIisTopTup- _lhsInm2ref- _lhsIopts- _lhsIstackDepth- _lhsItailCtx ->- (case (AppFunKind_NoApp) of- { _lhsOappFunKind ->- (case ([]) of- { _lhsOcrb ->- (case (CR.dbg "Core.ToCoreRun.CExpr.cre") of- { _creBase ->- (case (cseCtxWrap _lhsItailCtx _creBase) of- { _cre ->- (case (_cre) of- { _lhsOcre ->- (case ([]) of- { _creAppArgL ->- (case (_creAppArgL) of- { _lhsOcreAppArgL ->- (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of- { _creAppFun ->- (case (_creAppFun) of- { _lhsOcreAppFun ->- (case ([]) of- { _creLamArgL ->- (case (_creLamArgL) of- { _lhsOcreLamArgL ->- (case (_cre) of- { _creLamBody ->- (case (_creLamBody) of- { _lhsOcreLamBody ->- (case (panic "Core.ToCoreRun.CExpr.crse") of- { _crse ->- (case (_crse) of- { _lhsOcrse ->- (case (Nothing) of- { _lhsOmbFFIApp ->- (case (Nothing) of- { _lhsOmbLam ->- (case (Nothing) of- { _lhsOmbVar ->- (case (0) of- { _lhsOrefOffsetMax ->- (case (_lhsIstackDepth + 1) of- { _stackDepthHere ->- (case (_stackDepthHere) of- { _lhsOstackDepth ->- (case (_stackDepthHere) of- { _lhsOstackDepthMax ->- (case (panic "Core.ToCoreRun.CExpr.ref") of- { _vref ->- (case (_vref) of- { _lhsOvref ->- ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_Dbg_2)) of- { ( sem_CExpr_2) ->- ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }))- in sem_CExpr_Dbg_1)) of- { ( sem_CExpr_1) ->- ( _lhsOwhatBelow,sem_CExpr_1) }) }) })-sem_CExpr_Hole :: UID ->- T_CExpr-sem_CExpr_Hole uid_ =- (case (ExprIsOther) of- { _whatBelow ->- (case (_whatBelow) of- { _lhsOwhatBelow ->- (case ((let sem_CExpr_Hole_1 :: T_CExpr_1- sem_CExpr_Hole_1 =- (\ _lhsIlev- _lhsImodNr- _lhsIrefOffset- _lhsIwhatAbove ->- (case (Map.empty) of- { _lhsOnm2refGath ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CExpr_Hole_2 :: T_CExpr_2- sem_CExpr_Hole_2 =- (\ _lhsIevalCtx- _lhsIisTopApp- _lhsIisTopTup- _lhsInm2ref- _lhsIopts- _lhsIstackDepth- _lhsItailCtx ->- (case (AppFunKind_NoApp) of- { _lhsOappFunKind ->- (case ([]) of- { _lhsOcrb ->- (case (CR.dbg "Core.ToCoreRun.CExpr.cre") of- { _creBase ->- (case (cseCtxWrap _lhsItailCtx _creBase) of- { _cre ->- (case (_cre) of- { _lhsOcre ->- (case ([]) of- { _creAppArgL ->- (case (_creAppArgL) of- { _lhsOcreAppArgL ->- (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of- { _creAppFun ->- (case (_creAppFun) of- { _lhsOcreAppFun ->- (case ([]) of- { _creLamArgL ->- (case (_creLamArgL) of- { _lhsOcreLamArgL ->- (case (_cre) of- { _creLamBody ->- (case (_creLamBody) of- { _lhsOcreLamBody ->- (case (panic "Core.ToCoreRun.CExpr.crse") of- { _crse ->- (case (_crse) of- { _lhsOcrse ->- (case (Nothing) of- { _lhsOmbFFIApp ->- (case (Nothing) of- { _lhsOmbLam ->- (case (Nothing) of- { _lhsOmbVar ->- (case (0) of- { _lhsOrefOffsetMax ->- (case (_lhsIstackDepth + 1) of- { _stackDepthHere ->- (case (_stackDepthHere) of- { _lhsOstackDepth ->- (case (_stackDepthHere) of- { _lhsOstackDepthMax ->- (case (panic "Core.ToCoreRun.CExpr.ref") of- { _vref ->- (case (_vref) of- { _lhsOvref ->- ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_Hole_2)) of- { ( sem_CExpr_2) ->- ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }))- in sem_CExpr_Hole_1)) of- { ( sem_CExpr_1) ->- ( _lhsOwhatBelow,sem_CExpr_1) }) }) })-sem_CExpr_HoleLet :: UID ->- T_CExpr ->- T_CExpr-sem_CExpr_HoleLet bindsUid_ body_ =- (case (ExprIsOther) of- { _whatBelow ->- (case (_whatBelow) of- { _lhsOwhatBelow ->- (case ((let sem_CExpr_HoleLet_1 :: T_CExpr_1- sem_CExpr_HoleLet_1 =- (\ _lhsIlev- _lhsImodNr- _lhsIrefOffset- _lhsIwhatAbove ->- (case (ExprIsOther) of- { _whatAbove ->- (case (_whatAbove) of- { _bodyOwhatAbove ->- (case (_lhsIrefOffset) of- { _bodyOrefOffset ->- (case (_lhsImodNr) of- { _bodyOmodNr ->- (case (_lhsIlev) of- { _bodyOlev ->- (case (body_) of- { ( _bodyIwhatBelow,body_1) ->- (case (body_1 _bodyOlev _bodyOmodNr _bodyOrefOffset _bodyOwhatAbove) of- { ( _bodyInm2refGath,_bodyIrefOffset,body_2) ->- (case (_bodyInm2refGath) of- { _lhsOnm2refGath ->- (case (_bodyIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CExpr_HoleLet_2 :: T_CExpr_2- sem_CExpr_HoleLet_2 =- (\ _lhsIevalCtx- _lhsIisTopApp- _lhsIisTopTup- _lhsInm2ref- _lhsIopts- _lhsIstackDepth- _lhsItailCtx ->- (case (AppFunKind_NoApp) of- { _lhsOappFunKind ->- (case ([]) of- { _lhsOcrb ->- (case (CR.dbg "Core.ToCoreRun.CExpr.cre") of- { _creBase ->- (case (cseCtxWrap _lhsItailCtx _creBase) of- { _cre ->- (case (_cre) of- { _lhsOcre ->- (case ([]) of- { _creAppArgL ->- (case (_creAppArgL) of- { _lhsOcreAppArgL ->- (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of- { _creAppFun ->- (case (_creAppFun) of- { _lhsOcreAppFun ->- (case ([]) of- { _creLamArgL ->- (case (_creLamArgL) of- { _lhsOcreLamArgL ->- (case (_cre) of- { _creLamBody ->- (case (_creLamBody) of- { _lhsOcreLamBody ->- (case (panic "Core.ToCoreRun.CExpr.crse") of- { _crse ->- (case (_crse) of- { _lhsOcrse ->- (case (Nothing) of- { _lhsOmbFFIApp ->- (case (Nothing) of- { _lhsOmbLam ->- (case (Nothing) of- { _lhsOmbVar ->- (case (_lhsItailCtx) of- { _bodyOtailCtx ->- (case (_lhsIstackDepth) of- { _bodyOstackDepth ->- (case (_lhsIopts) of- { _bodyOopts ->- (case (_lhsInm2ref) of- { _bodyOnm2ref ->- (case (True) of- { _isTopTup ->- (case (_isTopTup) of- { _bodyOisTopTup ->- (case (True) of- { _isTopApp ->- (case (_isTopApp) of- { _bodyOisTopApp ->- (case (_lhsIevalCtx) of- { _bodyOevalCtx ->- (case (body_2 _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOnm2ref _bodyOopts _bodyOstackDepth _bodyOtailCtx) of- { ( _bodyIappFunKind,_bodyIcrb,_bodyIcre,_bodyIcreAppArgL,_bodyIcreAppFun,_bodyIcreLamArgL,_bodyIcreLamBody,_bodyIcrse,_bodyImbFFIApp,_bodyImbLam,_bodyImbVar,_bodyIrefOffsetMax,_bodyIstackDepth,_bodyIstackDepthMax,_bodyIvref) ->- (case (_bodyIrefOffsetMax) of- { _lhsOrefOffsetMax ->- (case (_lhsIstackDepth + 1) of- { _stackDepthHere ->- (case (_stackDepthHere) of- { _lhsOstackDepth ->- (case (_stackDepthHere) of- { _lhsOstackDepthMax ->- (case (panic "Core.ToCoreRun.CExpr.ref") of- { _vref ->- (case (_vref) of- { _lhsOvref ->- ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_HoleLet_2)) of- { ( sem_CExpr_2) ->- ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_HoleLet_1)) of- { ( sem_CExpr_1) ->- ( _lhsOwhatBelow,sem_CExpr_1) }) }) })-sem_CExpr_CoeArg :: T_CExpr-sem_CExpr_CoeArg =- (case (ExprIsOther) of- { _whatBelow ->- (case (_whatBelow) of- { _lhsOwhatBelow ->- (case ((let sem_CExpr_CoeArg_1 :: T_CExpr_1- sem_CExpr_CoeArg_1 =- (\ _lhsIlev- _lhsImodNr- _lhsIrefOffset- _lhsIwhatAbove ->- (case (Map.empty) of- { _lhsOnm2refGath ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CExpr_CoeArg_2 :: T_CExpr_2- sem_CExpr_CoeArg_2 =- (\ _lhsIevalCtx- _lhsIisTopApp- _lhsIisTopTup- _lhsInm2ref- _lhsIopts- _lhsIstackDepth- _lhsItailCtx ->- (case (AppFunKind_NoApp) of- { _lhsOappFunKind ->- (case ([]) of- { _lhsOcrb ->- (case (CR.dbg "Core.ToCoreRun.CExpr.cre") of- { _creBase ->- (case (cseCtxWrap _lhsItailCtx _creBase) of- { _cre ->- (case (_cre) of- { _lhsOcre ->- (case ([]) of- { _creAppArgL ->- (case (_creAppArgL) of- { _lhsOcreAppArgL ->- (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of- { _creAppFun ->- (case (_creAppFun) of- { _lhsOcreAppFun ->- (case ([]) of- { _creLamArgL ->- (case (_creLamArgL) of- { _lhsOcreLamArgL ->- (case (_cre) of- { _creLamBody ->- (case (_creLamBody) of- { _lhsOcreLamBody ->- (case (panic "Core.ToCoreRun.CExpr.crse") of- { _crse ->- (case (_crse) of- { _lhsOcrse ->- (case (Nothing) of- { _lhsOmbFFIApp ->- (case (Nothing) of- { _lhsOmbLam ->- (case (Nothing) of- { _lhsOmbVar ->- (case (0) of- { _lhsOrefOffsetMax ->- (case (_lhsIstackDepth + 1) of- { _stackDepthHere ->- (case (_stackDepthHere) of- { _lhsOstackDepth ->- (case (_stackDepthHere) of- { _lhsOstackDepthMax ->- (case (panic "Core.ToCoreRun.CExpr.ref") of- { _vref ->- (case (_vref) of- { _lhsOvref ->- ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_CoeArg_2)) of- { ( sem_CExpr_2) ->- ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }))- in sem_CExpr_CoeArg_1)) of- { ( sem_CExpr_1) ->- ( _lhsOwhatBelow,sem_CExpr_1) }) }) })-sem_CExpr_ImplsApp :: T_CExpr ->- ImplsVarId ->- T_CExpr-sem_CExpr_ImplsApp func_ uid_ =- (case (ExprIsOther) of- { _whatBelow ->- (case (_whatBelow) of- { _lhsOwhatBelow ->- (case ((let sem_CExpr_ImplsApp_1 :: T_CExpr_1- sem_CExpr_ImplsApp_1 =- (\ _lhsIlev- _lhsImodNr- _lhsIrefOffset- _lhsIwhatAbove ->- (case (ExprIsOther) of- { _whatAbove ->- (case (_whatAbove) of- { _funcOwhatAbove ->- (case (_lhsIrefOffset) of- { _funcOrefOffset ->- (case (_lhsImodNr) of- { _funcOmodNr ->- (case (_lhsIlev) of- { _funcOlev ->- (case (func_) of- { ( _funcIwhatBelow,func_1) ->- (case (func_1 _funcOlev _funcOmodNr _funcOrefOffset _funcOwhatAbove) of- { ( _funcInm2refGath,_funcIrefOffset,func_2) ->- (case (_funcInm2refGath) of- { _lhsOnm2refGath ->- (case (_funcIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CExpr_ImplsApp_2 :: T_CExpr_2- sem_CExpr_ImplsApp_2 =- (\ _lhsIevalCtx- _lhsIisTopApp- _lhsIisTopTup- _lhsInm2ref- _lhsIopts- _lhsIstackDepth- _lhsItailCtx ->- (case (AppFunKind_NoApp) of- { _lhsOappFunKind ->- (case ([]) of- { _lhsOcrb ->- (case (CR.dbg "Core.ToCoreRun.CExpr.cre") of- { _creBase ->- (case (cseCtxWrap _lhsItailCtx _creBase) of- { _cre ->- (case (_cre) of- { _lhsOcre ->- (case ([]) of- { _creAppArgL ->- (case (_creAppArgL) of- { _lhsOcreAppArgL ->- (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of- { _creAppFun ->- (case (_creAppFun) of- { _lhsOcreAppFun ->- (case ([]) of- { _creLamArgL ->- (case (_creLamArgL) of- { _lhsOcreLamArgL ->- (case (_cre) of- { _creLamBody ->- (case (_creLamBody) of- { _lhsOcreLamBody ->- (case (panic "Core.ToCoreRun.CExpr.crse") of- { _crse ->- (case (_crse) of- { _lhsOcrse ->- (case (Nothing) of- { _lhsOmbFFIApp ->- (case (Nothing) of- { _lhsOmbLam ->- (case (Nothing) of- { _lhsOmbVar ->- (case (_lhsItailCtx) of- { _funcOtailCtx ->- (case (_lhsIstackDepth) of- { _funcOstackDepth ->- (case (_lhsIopts) of- { _funcOopts ->- (case (_lhsInm2ref) of- { _funcOnm2ref ->- (case (True) of- { _isTopTup ->- (case (_isTopTup) of- { _funcOisTopTup ->- (case (True) of- { _isTopApp ->- (case (_isTopApp) of- { _funcOisTopApp ->- (case (_lhsIevalCtx) of- { _funcOevalCtx ->- (case (func_2 _funcOevalCtx _funcOisTopApp _funcOisTopTup _funcOnm2ref _funcOopts _funcOstackDepth _funcOtailCtx) of- { ( _funcIappFunKind,_funcIcrb,_funcIcre,_funcIcreAppArgL,_funcIcreAppFun,_funcIcreLamArgL,_funcIcreLamBody,_funcIcrse,_funcImbFFIApp,_funcImbLam,_funcImbVar,_funcIrefOffsetMax,_funcIstackDepth,_funcIstackDepthMax,_funcIvref) ->- (case (_funcIrefOffsetMax) of- { _lhsOrefOffsetMax ->- (case (_lhsIstackDepth + 1) of- { _stackDepthHere ->- (case (_stackDepthHere) of- { _lhsOstackDepth ->- (case (_stackDepthHere) of- { _lhsOstackDepthMax ->- (case (panic "Core.ToCoreRun.CExpr.ref") of- { _vref ->- (case (_vref) of- { _lhsOvref ->- ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_ImplsApp_2)) of- { ( sem_CExpr_2) ->- ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_ImplsApp_1)) of- { ( sem_CExpr_1) ->- ( _lhsOwhatBelow,sem_CExpr_1) }) }) })-sem_CExpr_ImplsLam :: ImplsVarId ->- T_CExpr ->- T_CExpr-sem_CExpr_ImplsLam uid_ body_ =- (case (ExprIsOther) of- { _whatBelow ->- (case (_whatBelow) of- { _lhsOwhatBelow ->- (case ((let sem_CExpr_ImplsLam_1 :: T_CExpr_1- sem_CExpr_ImplsLam_1 =- (\ _lhsIlev- _lhsImodNr- _lhsIrefOffset- _lhsIwhatAbove ->- (case (ExprIsOther) of- { _whatAbove ->- (case (_whatAbove) of- { _bodyOwhatAbove ->- (case (_lhsIrefOffset) of- { _bodyOrefOffset ->- (case (_lhsImodNr) of- { _bodyOmodNr ->- (case (_lhsIlev) of- { _bodyOlev ->- (case (body_) of- { ( _bodyIwhatBelow,body_1) ->- (case (body_1 _bodyOlev _bodyOmodNr _bodyOrefOffset _bodyOwhatAbove) of- { ( _bodyInm2refGath,_bodyIrefOffset,body_2) ->- (case (_bodyInm2refGath) of- { _lhsOnm2refGath ->- (case (_bodyIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CExpr_ImplsLam_2 :: T_CExpr_2- sem_CExpr_ImplsLam_2 =- (\ _lhsIevalCtx- _lhsIisTopApp- _lhsIisTopTup- _lhsInm2ref- _lhsIopts- _lhsIstackDepth- _lhsItailCtx ->- (case (AppFunKind_NoApp) of- { _lhsOappFunKind ->- (case ([]) of- { _lhsOcrb ->- (case (CR.dbg "Core.ToCoreRun.CExpr.cre") of- { _creBase ->- (case (cseCtxWrap _lhsItailCtx _creBase) of- { _cre ->- (case (_cre) of- { _lhsOcre ->- (case ([]) of- { _creAppArgL ->- (case (_creAppArgL) of- { _lhsOcreAppArgL ->- (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of- { _creAppFun ->- (case (_creAppFun) of- { _lhsOcreAppFun ->- (case ([]) of- { _creLamArgL ->- (case (_creLamArgL) of- { _lhsOcreLamArgL ->- (case (_cre) of- { _creLamBody ->- (case (_creLamBody) of- { _lhsOcreLamBody ->- (case (panic "Core.ToCoreRun.CExpr.crse") of- { _crse ->- (case (_crse) of- { _lhsOcrse ->- (case (Nothing) of- { _lhsOmbFFIApp ->- (case (Nothing) of- { _lhsOmbLam ->- (case (Nothing) of- { _lhsOmbVar ->- (case (_lhsItailCtx) of- { _bodyOtailCtx ->- (case (_lhsIstackDepth) of- { _bodyOstackDepth ->- (case (_lhsIopts) of- { _bodyOopts ->- (case (_lhsInm2ref) of- { _bodyOnm2ref ->- (case (True) of- { _isTopTup ->- (case (_isTopTup) of- { _bodyOisTopTup ->- (case (True) of- { _isTopApp ->- (case (_isTopApp) of- { _bodyOisTopApp ->- (case (_lhsIevalCtx) of- { _bodyOevalCtx ->- (case (body_2 _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOnm2ref _bodyOopts _bodyOstackDepth _bodyOtailCtx) of- { ( _bodyIappFunKind,_bodyIcrb,_bodyIcre,_bodyIcreAppArgL,_bodyIcreAppFun,_bodyIcreLamArgL,_bodyIcreLamBody,_bodyIcrse,_bodyImbFFIApp,_bodyImbLam,_bodyImbVar,_bodyIrefOffsetMax,_bodyIstackDepth,_bodyIstackDepthMax,_bodyIvref) ->- (case (_bodyIrefOffsetMax) of- { _lhsOrefOffsetMax ->- (case (_lhsIstackDepth + 1) of- { _stackDepthHere ->- (case (_stackDepthHere) of- { _lhsOstackDepth ->- (case (_stackDepthHere) of- { _lhsOstackDepthMax ->- (case (panic "Core.ToCoreRun.CExpr.ref") of- { _vref ->- (case (_vref) of- { _lhsOvref ->- ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_ImplsLam_2)) of- { ( sem_CExpr_2) ->- ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_ImplsLam_1)) of- { ( sem_CExpr_1) ->- ( _lhsOwhatBelow,sem_CExpr_1) }) }) })-sem_CExpr_Ann :: T_CExprAnn ->- T_CExpr ->- T_CExpr-sem_CExpr_Ann ann_ expr_ =- (case (expr_) of- { ( _exprIwhatBelow,expr_1) ->- (case (_exprIwhatBelow) of- { _lhsOwhatBelow ->- (case ((let sem_CExpr_Ann_1 :: T_CExpr_1- sem_CExpr_Ann_1 =- (\ _lhsIlev- _lhsImodNr- _lhsIrefOffset- _lhsIwhatAbove ->- (case (_lhsIwhatAbove) of- { _exprOwhatAbove ->- (case (_lhsIrefOffset) of- { _annOrefOffset ->- (case (ann_ _annOrefOffset) of- { ( _annIrefOffset,ann_1) ->- (case (_annIrefOffset) of- { _exprOrefOffset ->- (case (_lhsImodNr) of- { _exprOmodNr ->- (case (_lhsIlev) of- { _exprOlev ->- (case (expr_1 _exprOlev _exprOmodNr _exprOrefOffset _exprOwhatAbove) of- { ( _exprInm2refGath,_exprIrefOffset,expr_2) ->- (case (_exprInm2refGath) of- { _lhsOnm2refGath ->- (case (_exprIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CExpr_Ann_2 :: T_CExpr_2- sem_CExpr_Ann_2 =- (\ _lhsIevalCtx- _lhsIisTopApp- _lhsIisTopTup- _lhsInm2ref- _lhsIopts- _lhsIstackDepth- _lhsItailCtx ->- (case (_lhsItailCtx) of- { _exprOtailCtx ->- (case (_lhsIstackDepth) of- { _annOstackDepth ->- (case (_lhsIopts) of- { _annOopts ->- (case (_lhsInm2ref) of- { _annOnm2ref ->- (case (_lhsImodNr) of- { _annOmodNr ->- (case (_lhsIlev) of- { _annOlev ->- (case (ann_1 _annOlev _annOmodNr _annOnm2ref _annOopts _annOstackDepth) of- { ( _annIstackDepth) ->- (case (_annIstackDepth) of- { _exprOstackDepth ->- (case (_lhsIopts) of- { _exprOopts ->- (case (_lhsInm2ref) of- { _exprOnm2ref ->- (case (_lhsIisTopTup) of- { _exprOisTopTup ->- (case (_lhsIisTopApp) of- { _exprOisTopApp ->- (case (_lhsIevalCtx) of- { _exprOevalCtx ->- (case (expr_2 _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of- { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax,_exprIvref) ->- (case (_exprIappFunKind) of- { _lhsOappFunKind ->- (case (_exprIcrb) of- { _lhsOcrb ->- (case (_exprIcre) of- { _lhsOcre ->- (case (_exprIcreAppArgL) of- { _lhsOcreAppArgL ->- (case (_exprIcreAppFun) of- { _lhsOcreAppFun ->- (case (_exprIcreLamArgL) of- { _lhsOcreLamArgL ->- (case (_exprIcreLamBody) of- { _lhsOcreLamBody ->- (case (panic "Core.ToCoreRun.CExpr.crse") of- { _crse ->- (case (_crse) of- { _lhsOcrse ->- (case (_exprImbFFIApp) of- { _lhsOmbFFIApp ->- (case (_exprImbLam) of- { _lhsOmbLam ->- (case (_exprImbVar) of- { _lhsOmbVar ->- (case (_exprIrefOffsetMax) of- { _lhsOrefOffsetMax ->- (case (_exprIstackDepth) of- { _lhsOstackDepth ->- (case (_exprIstackDepthMax) of- { _lhsOstackDepthMax ->- (case (panic "Core.ToCoreRun.CExpr.ref") of- { _vref ->- (case (_vref) of- { _lhsOvref ->- ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_Ann_2)) of- { ( sem_CExpr_2) ->- ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }))- in sem_CExpr_Ann_1)) of- { ( sem_CExpr_1) ->- ( _lhsOwhatBelow,sem_CExpr_1) }) }) })--- CExprAnn -----------------------------------------------------{-- visit 0:- chained attribute:- refOffset : Int- visit 1:- inherited attributes:- lev : Int- modNr : Int- nm2ref : CR.Nm2RefMp- opts : EHCOpts- chained attribute:- stackDepth : Int- alternatives:- alternative Ty:- child ty : {Ty}- alternative Coe:- child coe : {RelevCoe}- alternative Debug:- child info : {String}--}--- cata-sem_CExprAnn :: CExprAnn ->- T_CExprAnn-sem_CExprAnn (CExprAnn_Ty _ty) =- (sem_CExprAnn_Ty _ty)-sem_CExprAnn (CExprAnn_Coe _coe) =- (sem_CExprAnn_Coe _coe)-sem_CExprAnn (CExprAnn_Debug _info) =- (sem_CExprAnn_Debug _info)--- semantic domain-type T_CExprAnn = Int ->- ( Int,T_CExprAnn_1)-type T_CExprAnn_1 = Int ->- Int ->- (CR.Nm2RefMp) ->- EHCOpts ->- Int ->- ( Int)-sem_CExprAnn_Ty :: Ty ->- T_CExprAnn-sem_CExprAnn_Ty ty_ =- (\ _lhsIrefOffset ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CExprAnn_Ty_1 :: T_CExprAnn_1- sem_CExprAnn_Ty_1 =- (\ _lhsIlev- _lhsImodNr- _lhsInm2ref- _lhsIopts- _lhsIstackDepth ->- (case (_lhsIstackDepth) of- { _lhsOstackDepth ->- ( _lhsOstackDepth) }))- in sem_CExprAnn_Ty_1)) of- { ( sem_CExprAnn_1) ->- ( _lhsOrefOffset,sem_CExprAnn_1) }) }))-sem_CExprAnn_Coe :: RelevCoe ->- T_CExprAnn-sem_CExprAnn_Coe coe_ =- (\ _lhsIrefOffset ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CExprAnn_Coe_1 :: T_CExprAnn_1- sem_CExprAnn_Coe_1 =- (\ _lhsIlev- _lhsImodNr- _lhsInm2ref- _lhsIopts- _lhsIstackDepth ->- (case (_lhsIstackDepth) of- { _lhsOstackDepth ->- ( _lhsOstackDepth) }))- in sem_CExprAnn_Coe_1)) of- { ( sem_CExprAnn_1) ->- ( _lhsOrefOffset,sem_CExprAnn_1) }) }))-sem_CExprAnn_Debug :: String ->- T_CExprAnn-sem_CExprAnn_Debug info_ =- (\ _lhsIrefOffset ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CExprAnn_Debug_1 :: T_CExprAnn_1- sem_CExprAnn_Debug_1 =- (\ _lhsIlev- _lhsImodNr- _lhsInm2ref- _lhsIopts- _lhsIstackDepth ->- (case (_lhsIstackDepth) of- { _lhsOstackDepth ->- ( _lhsOstackDepth) }))- in sem_CExprAnn_Debug_1)) of- { ( sem_CExprAnn_1) ->- ( _lhsOrefOffset,sem_CExprAnn_1) }) }))--- CImport ------------------------------------------------------{-- alternatives:- alternative Import:- child nm : {HsName}--}--- cata-sem_CImport :: CImport ->- T_CImport-sem_CImport (CImport_Import _nm) =- (sem_CImport_Import _nm)--- semantic domain-type T_CImport = ( )-sem_CImport_Import :: HsName ->- T_CImport-sem_CImport_Import nm_ =- ( )--- CImportL -----------------------------------------------------{-- alternatives:- alternative Cons:- child hd : CImport - child tl : CImportL - alternative Nil:--}--- cata-sem_CImportL :: CImportL ->- T_CImportL-sem_CImportL list =- (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list))--- semantic domain-type T_CImportL = ( )-sem_CImportL_Cons :: T_CImport ->- T_CImportL ->- T_CImportL-sem_CImportL_Cons hd_ tl_ =- ( )-sem_CImportL_Nil :: T_CImportL-sem_CImportL_Nil =- ( )--- CMetaBind ----------------------------------------------------{-- visit 0:- chained attribute:- refOffset : Int- visit 1:- inherited attributes:- lev : Int- modNr : Int- nm2ref : CR.Nm2RefMp- opts : EHCOpts- chained attribute:- stackDepth : Int- alternatives:- alternative Plain:- alternative Function0:- alternative Function1:- alternative Apply0:--}--- cata-sem_CMetaBind :: CMetaBind ->- T_CMetaBind-sem_CMetaBind (CMetaBind_Plain) =- (sem_CMetaBind_Plain)-sem_CMetaBind (CMetaBind_Function0) =- (sem_CMetaBind_Function0)-sem_CMetaBind (CMetaBind_Function1) =- (sem_CMetaBind_Function1)-sem_CMetaBind (CMetaBind_Apply0) =- (sem_CMetaBind_Apply0)--- semantic domain-type T_CMetaBind = Int ->- ( Int,T_CMetaBind_1)-type T_CMetaBind_1 = Int ->- Int ->- (CR.Nm2RefMp) ->- EHCOpts ->- Int ->- ( Int)-sem_CMetaBind_Plain :: T_CMetaBind-sem_CMetaBind_Plain =- (\ _lhsIrefOffset ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CMetaBind_Plain_1 :: T_CMetaBind_1- sem_CMetaBind_Plain_1 =- (\ _lhsIlev- _lhsImodNr- _lhsInm2ref- _lhsIopts- _lhsIstackDepth ->- (case (_lhsIstackDepth) of- { _lhsOstackDepth ->- ( _lhsOstackDepth) }))- in sem_CMetaBind_Plain_1)) of- { ( sem_CMetaBind_1) ->- ( _lhsOrefOffset,sem_CMetaBind_1) }) }))-sem_CMetaBind_Function0 :: T_CMetaBind-sem_CMetaBind_Function0 =- (\ _lhsIrefOffset ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CMetaBind_Function0_1 :: T_CMetaBind_1- sem_CMetaBind_Function0_1 =- (\ _lhsIlev- _lhsImodNr- _lhsInm2ref- _lhsIopts- _lhsIstackDepth ->- (case (_lhsIstackDepth) of- { _lhsOstackDepth ->- ( _lhsOstackDepth) }))- in sem_CMetaBind_Function0_1)) of- { ( sem_CMetaBind_1) ->- ( _lhsOrefOffset,sem_CMetaBind_1) }) }))-sem_CMetaBind_Function1 :: T_CMetaBind-sem_CMetaBind_Function1 =- (\ _lhsIrefOffset ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CMetaBind_Function1_1 :: T_CMetaBind_1- sem_CMetaBind_Function1_1 =- (\ _lhsIlev- _lhsImodNr- _lhsInm2ref- _lhsIopts- _lhsIstackDepth ->- (case (_lhsIstackDepth) of- { _lhsOstackDepth ->- ( _lhsOstackDepth) }))- in sem_CMetaBind_Function1_1)) of- { ( sem_CMetaBind_1) ->- ( _lhsOrefOffset,sem_CMetaBind_1) }) }))-sem_CMetaBind_Apply0 :: T_CMetaBind-sem_CMetaBind_Apply0 =- (\ _lhsIrefOffset ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CMetaBind_Apply0_1 :: T_CMetaBind_1- sem_CMetaBind_Apply0_1 =- (\ _lhsIlev- _lhsImodNr- _lhsInm2ref- _lhsIopts- _lhsIstackDepth ->- (case (_lhsIstackDepth) of- { _lhsOstackDepth ->- ( _lhsOstackDepth) }))- in sem_CMetaBind_Apply0_1)) of- { ( sem_CMetaBind_1) ->- ( _lhsOrefOffset,sem_CMetaBind_1) }) }))--- CMetaVal -----------------------------------------------------{-- visit 0:- chained attribute:- refOffset : Int- visit 1:- inherited attributes:- lev : Int- modNr : Int- nm2ref : CR.Nm2RefMp- opts : EHCOpts- chained attribute:- stackDepth : Int- alternatives:- alternative Val:- alternative Dict:- alternative DictClass:- child tracks : {[Track]}- alternative DictInstance:- child tracks : {[Track]}- alternative Track:- child track : {Track}--}--- cata-sem_CMetaVal :: CMetaVal ->- T_CMetaVal-sem_CMetaVal (CMetaVal_Val) =- (sem_CMetaVal_Val)-sem_CMetaVal (CMetaVal_Dict) =- (sem_CMetaVal_Dict)-sem_CMetaVal (CMetaVal_DictClass _tracks) =- (sem_CMetaVal_DictClass _tracks)-sem_CMetaVal (CMetaVal_DictInstance _tracks) =- (sem_CMetaVal_DictInstance _tracks)-sem_CMetaVal (CMetaVal_Track _track) =- (sem_CMetaVal_Track _track)--- semantic domain-type T_CMetaVal = Int ->- ( Int,T_CMetaVal_1)-type T_CMetaVal_1 = Int ->- Int ->- (CR.Nm2RefMp) ->- EHCOpts ->- Int ->- ( Int)-sem_CMetaVal_Val :: T_CMetaVal-sem_CMetaVal_Val =- (\ _lhsIrefOffset ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CMetaVal_Val_1 :: T_CMetaVal_1- sem_CMetaVal_Val_1 =- (\ _lhsIlev- _lhsImodNr- _lhsInm2ref- _lhsIopts- _lhsIstackDepth ->- (case (_lhsIstackDepth) of- { _lhsOstackDepth ->- ( _lhsOstackDepth) }))- in sem_CMetaVal_Val_1)) of- { ( sem_CMetaVal_1) ->- ( _lhsOrefOffset,sem_CMetaVal_1) }) }))-sem_CMetaVal_Dict :: T_CMetaVal-sem_CMetaVal_Dict =- (\ _lhsIrefOffset ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CMetaVal_Dict_1 :: T_CMetaVal_1- sem_CMetaVal_Dict_1 =- (\ _lhsIlev- _lhsImodNr- _lhsInm2ref- _lhsIopts- _lhsIstackDepth ->- (case (_lhsIstackDepth) of- { _lhsOstackDepth ->- ( _lhsOstackDepth) }))- in sem_CMetaVal_Dict_1)) of- { ( sem_CMetaVal_1) ->- ( _lhsOrefOffset,sem_CMetaVal_1) }) }))-sem_CMetaVal_DictClass :: ([Track]) ->- T_CMetaVal-sem_CMetaVal_DictClass tracks_ =- (\ _lhsIrefOffset ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CMetaVal_DictClass_1 :: T_CMetaVal_1- sem_CMetaVal_DictClass_1 =- (\ _lhsIlev- _lhsImodNr- _lhsInm2ref- _lhsIopts- _lhsIstackDepth ->- (case (_lhsIstackDepth) of- { _lhsOstackDepth ->- ( _lhsOstackDepth) }))- in sem_CMetaVal_DictClass_1)) of- { ( sem_CMetaVal_1) ->- ( _lhsOrefOffset,sem_CMetaVal_1) }) }))-sem_CMetaVal_DictInstance :: ([Track]) ->- T_CMetaVal-sem_CMetaVal_DictInstance tracks_ =- (\ _lhsIrefOffset ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CMetaVal_DictInstance_1 :: T_CMetaVal_1- sem_CMetaVal_DictInstance_1 =- (\ _lhsIlev- _lhsImodNr- _lhsInm2ref- _lhsIopts- _lhsIstackDepth ->- (case (_lhsIstackDepth) of- { _lhsOstackDepth ->- ( _lhsOstackDepth) }))- in sem_CMetaVal_DictInstance_1)) of- { ( sem_CMetaVal_1) ->- ( _lhsOrefOffset,sem_CMetaVal_1) }) }))-sem_CMetaVal_Track :: Track ->- T_CMetaVal-sem_CMetaVal_Track track_ =- (\ _lhsIrefOffset ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CMetaVal_Track_1 :: T_CMetaVal_1- sem_CMetaVal_Track_1 =- (\ _lhsIlev- _lhsImodNr- _lhsInm2ref- _lhsIopts- _lhsIstackDepth ->- (case (_lhsIstackDepth) of- { _lhsOstackDepth ->- ( _lhsOstackDepth) }))- in sem_CMetaVal_Track_1)) of- { ( sem_CMetaVal_1) ->- ( _lhsOrefOffset,sem_CMetaVal_1) }) }))--- CMetas -------------------------------------------------------{-- visit 0:- chained attribute:- refOffset : Int- visit 1:- inherited attributes:- lev : Int- modNr : Int- nm2ref : CR.Nm2RefMp- opts : EHCOpts- chained attribute:- stackDepth : Int- alternatives:- alternative Tuple:- child x1 : CMetaBind - child x2 : CMetaVal --}--- cata-sem_CMetas :: CMetas ->- T_CMetas-sem_CMetas ( x1,x2) =- (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2))--- semantic domain-type T_CMetas = Int ->- ( Int,T_CMetas_1)-type T_CMetas_1 = Int ->- Int ->- (CR.Nm2RefMp) ->- EHCOpts ->- Int ->- ( Int)-sem_CMetas_Tuple :: T_CMetaBind ->- T_CMetaVal ->- T_CMetas-sem_CMetas_Tuple x1_ x2_ =- (\ _lhsIrefOffset ->- (case (_lhsIrefOffset) of- { _x1OrefOffset ->- (case (x1_ _x1OrefOffset) of- { ( _x1IrefOffset,x1_1) ->- (case (_x1IrefOffset) of- { _x2OrefOffset ->- (case (x2_ _x2OrefOffset) of- { ( _x2IrefOffset,x2_1) ->- (case (_x2IrefOffset) of- { _lhsOrefOffset ->- (case ((let sem_CMetas_Tuple_1 :: T_CMetas_1- sem_CMetas_Tuple_1 =- (\ _lhsIlev- _lhsImodNr- _lhsInm2ref- _lhsIopts- _lhsIstackDepth ->- (case (_lhsIstackDepth) of- { _x1OstackDepth ->- (case (_lhsIopts) of- { _x1Oopts ->- (case (_lhsInm2ref) of- { _x1Onm2ref ->- (case (_lhsImodNr) of- { _x1OmodNr ->- (case (_lhsIlev) of- { _x1Olev ->- (case (x1_1 _x1Olev _x1OmodNr _x1Onm2ref _x1Oopts _x1OstackDepth) of- { ( _x1IstackDepth) ->- (case (_x1IstackDepth) of- { _x2OstackDepth ->- (case (_lhsIopts) of- { _x2Oopts ->- (case (_lhsInm2ref) of- { _x2Onm2ref ->- (case (_lhsImodNr) of- { _x2OmodNr ->- (case (_lhsIlev) of- { _x2Olev ->- (case (x2_1 _x2Olev _x2OmodNr _x2Onm2ref _x2Oopts _x2OstackDepth) of- { ( _x2IstackDepth) ->- (case (_x2IstackDepth) of- { _lhsOstackDepth ->- ( _lhsOstackDepth) }) }) }) }) }) }) }) }) }) }) }) }) }))- in sem_CMetas_Tuple_1)) of- { ( sem_CMetas_1) ->- ( _lhsOrefOffset,sem_CMetas_1) }) }) }) }) }) }))--- CModule ------------------------------------------------------{-- visit 0:- inherited attributes:- lev : Int- modNr : Int- nm2ref : CR.Nm2RefMp- opts : EHCOpts- synthesized attributes:- crm : CR.Mod- nm2refGath : CR.Nm2RefMp- alternatives:- alternative Mod:- child moduleNm : {HsName}- child exports : CExportL - child imports : CImportL - child declMetas : CDeclMetaL - child expr : CExpr - visit 0:- local whatAbove : {WhatExpr}- local tailCtx : _- local nm2refNew : _- local crmBinds : _- local creMod : _--}--- cata-sem_CModule :: CModule ->- T_CModule-sem_CModule (CModule_Mod _moduleNm _exports _imports _declMetas _expr) =- (sem_CModule_Mod _moduleNm (sem_CExportL _exports) (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr))--- semantic domain-type T_CModule = Int ->- Int ->- (CR.Nm2RefMp) ->- EHCOpts ->- ( (CR.Mod),(CR.Nm2RefMp))-sem_CModule_Mod :: HsName ->- T_CExportL ->- T_CImportL ->- T_CDeclMetaL ->- T_CExpr ->- T_CModule-sem_CModule_Mod moduleNm_ exports_ imports_ declMetas_ expr_ =- (\ _lhsIlev- _lhsImodNr- _lhsInm2ref- _lhsIopts ->- (case (ExprIsOther) of- { _whatAbove ->- (case (_whatAbove) of- { _exprOwhatAbove ->- (case (TailCtx_Plain) of- { _tailCtx ->- (case (_tailCtx) of- { _exprOtailCtx ->- (case (_lhsImodNr) of- { _exprOmodNr ->- (case (_lhsIlev) of- { _exprOlev ->- (case (0) of- { _exprOrefOffset ->- (case (expr_) of- { ( _exprIwhatBelow,expr_1) ->- (case (expr_1 _exprOlev _exprOmodNr _exprOrefOffset _exprOwhatAbove) of- { ( _exprInm2refGath,_exprIrefOffset,expr_2) ->- (case (_exprInm2refGath) of- { _nm2refNew ->- (case (_nm2refNew `Map.union` _lhsInm2ref) of- { _exprOnm2ref ->- (case (0) of- { _exprOstackDepth ->- (case (_lhsIopts) of- { _exprOopts ->- (case (EvalCtx_Eval) of- { _exprOevalCtx ->- (case (True) of- { _exprOisTopTup ->- (case (True) of- { _exprOisTopApp ->- (case (expr_2 _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of- { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax,_exprIvref) ->- (case (CR.crarrayFromList $ map snd _exprIcrb) of- { _crmBinds ->- (case (_exprIcre) of- { _creMod ->- (case (declMetas_) of- { ( _declMetasIcrmt) ->- (case (CR.Mod_Mod (CR.nm2RefMpInverse _nm2refNew)- moduleNm_ _lhsImodNr (_exprIstackDepthMax + 2 )- _declMetasIcrmt _crmBinds (CR.mkEval _creMod)) of- { _lhsOcrm ->- (case (_exprInm2refGath) of- { _lhsOnm2refGath ->- ( _lhsOcrm,_lhsOnm2refGath) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))--- CPat ---------------------------------------------------------{-- visit 0:- inherited attributes:- lev : Int- modNr : Int- nm2ref : CR.Nm2RefMp- opts : EHCOpts- chained attributes:- refOffset : Int- stackDepth : Int- synthesized attributes:- crp : CR.Pat- fldNmL : [HsName]- alternatives:- alternative Var:- child pnm : {HsName}- alternative Con:- child tag : {CTag}- child rest : CPatRest - child binds : CPatFldL - alternative Int:- child int : {Int}- alternative Char:- child char : {Char}- alternative BoolExpr:- child cexpr : {CExpr}--}--- cata-sem_CPat :: CPat ->- T_CPat-sem_CPat (CPat_Var _pnm) =- (sem_CPat_Var _pnm)-sem_CPat (CPat_Con _tag _rest _binds) =- (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds))-sem_CPat (CPat_Int _int) =- (sem_CPat_Int _int)-sem_CPat (CPat_Char _char) =- (sem_CPat_Char _char)-sem_CPat (CPat_BoolExpr _cexpr) =- (sem_CPat_BoolExpr _cexpr)--- semantic domain-type T_CPat = Int ->- Int ->- (CR.Nm2RefMp) ->- EHCOpts ->- Int ->- Int ->- ( (CR.Pat),([HsName]),Int,Int)-sem_CPat_Var :: HsName ->- T_CPat-sem_CPat_Var pnm_ =- (\ _lhsIlev- _lhsImodNr- _lhsInm2ref- _lhsIopts- _lhsIrefOffset- _lhsIstackDepth ->- (case (CR.Pat_Con 0) of- { _lhsOcrp ->- (case ([]) of- { _lhsOfldNmL ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case (_lhsIstackDepth) of- { _lhsOstackDepth ->- ( _lhsOcrp,_lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) }) }))-sem_CPat_Con :: CTag ->- T_CPatRest ->- T_CPatFldL ->- T_CPat-sem_CPat_Con tag_ rest_ binds_ =- (\ _lhsIlev- _lhsImodNr- _lhsInm2ref- _lhsIopts- _lhsIrefOffset- _lhsIstackDepth ->- (case (CR.Pat_Con (ctagTag tag_)) of- { _lhsOcrp ->- (case (_lhsIstackDepth) of- { _restOstackDepth ->- (case (_lhsIrefOffset) of- { _restOrefOffset ->- (case (_lhsIopts) of- { _restOopts ->- (case (_lhsInm2ref) of- { _restOnm2ref ->- (case (_lhsImodNr) of- { _restOmodNr ->- (case (_lhsIlev) of- { _restOlev ->- (case (rest_ _restOlev _restOmodNr _restOnm2ref _restOopts _restOrefOffset _restOstackDepth) of- { ( _restIrefOffset,_restIstackDepth) ->- (case (_restIstackDepth) of- { _bindsOstackDepth ->- (case (_restIrefOffset) of- { _bindsOrefOffset ->- (case (_lhsIopts) of- { _bindsOopts ->- (case (_lhsInm2ref) of- { _bindsOnm2ref ->- (case (_lhsImodNr) of- { _bindsOmodNr ->- (case (_lhsIlev) of- { _bindsOlev ->- (case (binds_ _bindsOlev _bindsOmodNr _bindsOnm2ref _bindsOopts _bindsOrefOffset _bindsOstackDepth) of- { ( _bindsIfldNmL,_bindsIrefOffset,_bindsIstackDepth) ->- (case (_bindsIfldNmL) of- { _lhsOfldNmL ->- (case (_bindsIrefOffset) of- { _lhsOrefOffset ->- (case (_bindsIstackDepth) of- { _lhsOstackDepth ->- ( _lhsOcrp,_lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))-sem_CPat_Int :: Int ->- T_CPat-sem_CPat_Int int_ =- (\ _lhsIlev- _lhsImodNr- _lhsInm2ref- _lhsIopts- _lhsIrefOffset- _lhsIstackDepth ->- (case (CR.Pat_Con 0) of- { _lhsOcrp ->- (case ([]) of- { _lhsOfldNmL ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case (_lhsIstackDepth) of- { _lhsOstackDepth ->- ( _lhsOcrp,_lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) }) }))-sem_CPat_Char :: Char ->- T_CPat-sem_CPat_Char char_ =- (\ _lhsIlev- _lhsImodNr- _lhsInm2ref- _lhsIopts- _lhsIrefOffset- _lhsIstackDepth ->- (case (CR.Pat_Con 0) of- { _lhsOcrp ->- (case ([]) of- { _lhsOfldNmL ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case (_lhsIstackDepth) of- { _lhsOstackDepth ->- ( _lhsOcrp,_lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) }) }))-sem_CPat_BoolExpr :: CExpr ->- T_CPat-sem_CPat_BoolExpr cexpr_ =- (\ _lhsIlev- _lhsImodNr- _lhsInm2ref- _lhsIopts- _lhsIrefOffset- _lhsIstackDepth ->- (case (CR.Pat_Con 0) of- { _lhsOcrp ->- (case ([]) of- { _lhsOfldNmL ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case (_lhsIstackDepth) of- { _lhsOstackDepth ->- ( _lhsOcrp,_lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) }) }))--- CPatFld ------------------------------------------------------{-- visit 0:- inherited attributes:- lev : Int- modNr : Int- nm2ref : CR.Nm2RefMp- opts : EHCOpts- chained attributes:- refOffset : Int- stackDepth : Int- synthesized attribute:- fldNmL : [HsName]- alternatives:- alternative Fld:- child lbl : {HsName}- child offset : CExpr - child bind : CBind - child fldAnns : CBindAnnL - visit 0:- local whatAbove : {WhatExpr}- local fldNm : _- local tailCtx : _--}--- cata-sem_CPatFld :: CPatFld ->- T_CPatFld-sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) =- (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns))--- semantic domain-type T_CPatFld = Int ->- Int ->- (CR.Nm2RefMp) ->- EHCOpts ->- Int ->- Int ->- ( ([HsName]),Int,Int)-sem_CPatFld_Fld :: HsName ->- T_CExpr ->- T_CBind ->- T_CBindAnnL ->- T_CPatFld-sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ =- (\ _lhsIlev- _lhsImodNr- _lhsInm2ref- _lhsIopts- _lhsIrefOffset- _lhsIstackDepth ->- (case (_lhsIrefOffset) of- { _offsetOrefOffset ->- (case (offset_) of- { ( _offsetIwhatBelow,offset_1) ->- (case (ExprIsOther) of- { _whatAbove ->- (case (_whatAbove) of- { _offsetOwhatAbove ->- (case (_lhsImodNr) of- { _offsetOmodNr ->- (case (_lhsIlev) of- { _offsetOlev ->- (case (offset_1 _offsetOlev _offsetOmodNr _offsetOrefOffset _offsetOwhatAbove) of- { ( _offsetInm2refGath,_offsetIrefOffset,offset_2) ->- (case (_offsetIrefOffset) of- { _bindOrefOffset ->- (case (_lhsImodNr) of- { _bindOmodNr ->- (case (_lhsIlev) of- { _bindOlev ->- (case (False) of- { _bindOisGlobal ->- (case (bind_ _bindOisGlobal _bindOlev _bindOmodNr _bindOrefOffset) of- { ( _bindInm,_bindInm2refGath,_bindIrefOffset,bind_1) ->- (case (_bindInm) of- { _fldNm ->- (case ([_fldNm]) of- { _lhsOfldNmL ->- (case (_bindIrefOffset) of- { _fldAnnsOrefOffset ->- (case (_lhsIstackDepth) of- { _offsetOstackDepth ->- (case (TailCtx_Plain) of- { _tailCtx ->- (case (_tailCtx) of- { _offsetOtailCtx ->- (case (_lhsIopts) of- { _offsetOopts ->- (case (_lhsInm2ref) of- { _offsetOnm2ref ->- (case (EvalCtx_Eval) of- { _offsetOevalCtx ->- (case (True) of- { _offsetOisTopTup ->- (case (True) of- { _offsetOisTopApp ->- (case (offset_2 _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOnm2ref _offsetOopts _offsetOstackDepth _offsetOtailCtx) of- { ( _offsetIappFunKind,_offsetIcrb,_offsetIcre,_offsetIcreAppArgL,_offsetIcreAppFun,_offsetIcreLamArgL,_offsetIcreLamBody,_offsetIcrse,_offsetImbFFIApp,_offsetImbLam,_offsetImbVar,_offsetIrefOffsetMax,_offsetIstackDepth,_offsetIstackDepthMax,_offsetIvref) ->- (case (_offsetIstackDepth) of- { _bindOstackDepth ->- (case (EvalCtx_None) of- { _bindOevalCtx ->- (case (_lhsIopts) of- { _bindOopts ->- (case (_lhsInm2ref) of- { _bindOnm2ref ->- (case (acoreBindcategPlain) of- { _bindOletBindingsCateg ->- (case (bind_1 _bindOevalCtx _bindOletBindingsCateg _bindOnm2ref _bindOopts _bindOstackDepth) of- { ( _bindIcrb,_bindIrefOffsetMax,_bindIstackDepth,_bindIstackDepthMax) ->- (case (_bindIstackDepth) of- { _fldAnnsOstackDepth ->- (case (_lhsIopts) of- { _fldAnnsOopts ->- (case (_lhsInm2ref) of- { _fldAnnsOnm2ref ->- (case (_lhsImodNr) of- { _fldAnnsOmodNr ->- (case (_lhsIlev) of- { _fldAnnsOlev ->- (case (fldAnns_ _fldAnnsOlev _fldAnnsOmodNr _fldAnnsOnm2ref _fldAnnsOopts _fldAnnsOrefOffset _fldAnnsOstackDepth) of- { ( _fldAnnsIrefOffset,_fldAnnsIstackDepth) ->- (case (_fldAnnsIrefOffset) of- { _lhsOrefOffset ->- (case (_fldAnnsIstackDepth) of- { _lhsOstackDepth ->- ( _lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))--- CPatFldL -----------------------------------------------------{-- visit 0:- inherited attributes:- lev : Int- modNr : Int- nm2ref : CR.Nm2RefMp- opts : EHCOpts- chained attributes:- refOffset : Int- stackDepth : Int- synthesized attribute:- fldNmL : [HsName]- alternatives:- alternative Cons:- child hd : CPatFld - child tl : CPatFldL - alternative Nil:--}--- cata-sem_CPatFldL :: CPatFldL ->- T_CPatFldL-sem_CPatFldL list =- (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list))--- semantic domain-type T_CPatFldL = Int ->- Int ->- (CR.Nm2RefMp) ->- EHCOpts ->- Int ->- Int ->- ( ([HsName]),Int,Int)-sem_CPatFldL_Cons :: T_CPatFld ->- T_CPatFldL ->- T_CPatFldL-sem_CPatFldL_Cons hd_ tl_ =- (\ _lhsIlev- _lhsImodNr- _lhsInm2ref- _lhsIopts- _lhsIrefOffset- _lhsIstackDepth ->- (case (_lhsIstackDepth) of- { _hdOstackDepth ->- (case (_lhsIrefOffset) of- { _hdOrefOffset ->- (case (_lhsIlev) of- { _hdOlev ->- (case (_lhsIopts) of- { _hdOopts ->- (case (_lhsInm2ref) of- { _hdOnm2ref ->- (case (_lhsImodNr) of- { _hdOmodNr ->- (case (hd_ _hdOlev _hdOmodNr _hdOnm2ref _hdOopts _hdOrefOffset _hdOstackDepth) of- { ( _hdIfldNmL,_hdIrefOffset,_hdIstackDepth) ->- (case (_hdIstackDepth) of- { _tlOstackDepth ->- (case (_hdIrefOffset) of- { _tlOrefOffset ->- (case (_lhsIopts) of- { _tlOopts ->- (case (_lhsInm2ref) of- { _tlOnm2ref ->- (case (_lhsImodNr) of- { _tlOmodNr ->- (case (_lhsIlev) of- { _tlOlev ->- (case (tl_ _tlOlev _tlOmodNr _tlOnm2ref _tlOopts _tlOrefOffset _tlOstackDepth) of- { ( _tlIfldNmL,_tlIrefOffset,_tlIstackDepth) ->- (case (_hdIfldNmL ++ _tlIfldNmL) of- { _lhsOfldNmL ->- (case (_tlIrefOffset) of- { _lhsOrefOffset ->- (case (_tlIstackDepth) of- { _lhsOstackDepth ->- ( _lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))-sem_CPatFldL_Nil :: T_CPatFldL-sem_CPatFldL_Nil =- (\ _lhsIlev- _lhsImodNr- _lhsInm2ref- _lhsIopts- _lhsIrefOffset- _lhsIstackDepth ->- (case ([]) of- { _lhsOfldNmL ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case (_lhsIstackDepth) of- { _lhsOstackDepth ->- ( _lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) }))--- CPatRest -----------------------------------------------------{-- visit 0:- inherited attributes:- lev : Int- modNr : Int- nm2ref : CR.Nm2RefMp- opts : EHCOpts- chained attributes:- refOffset : Int- stackDepth : Int- alternatives:- alternative Var:- child nm : {HsName}- alternative Empty:--}--- cata-sem_CPatRest :: CPatRest ->- T_CPatRest-sem_CPatRest (CPatRest_Var _nm) =- (sem_CPatRest_Var _nm)-sem_CPatRest (CPatRest_Empty) =- (sem_CPatRest_Empty)--- semantic domain-type T_CPatRest = Int ->- Int ->- (CR.Nm2RefMp) ->- EHCOpts ->- Int ->- Int ->- ( Int,Int)-sem_CPatRest_Var :: HsName ->- T_CPatRest-sem_CPatRest_Var nm_ =- (\ _lhsIlev- _lhsImodNr- _lhsInm2ref- _lhsIopts- _lhsIrefOffset- _lhsIstackDepth ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case (_lhsIstackDepth) of- { _lhsOstackDepth ->- ( _lhsOrefOffset,_lhsOstackDepth) }) }))-sem_CPatRest_Empty :: T_CPatRest-sem_CPatRest_Empty =- (\ _lhsIlev- _lhsImodNr- _lhsInm2ref- _lhsIopts- _lhsIrefOffset- _lhsIstackDepth ->- (case (_lhsIrefOffset) of- { _lhsOrefOffset ->- (case (_lhsIstackDepth) of- { _lhsOstackDepth ->- ( _lhsOrefOffset,_lhsOstackDepth) }) }))--- CodeAGItf ----------------------------------------------------{-- visit 0:- inherited attributes:- modNr : Int- nm2ref : CR.Nm2RefMp- opts : EHCOpts- synthesized attributes:- crm : CR.Mod- nm2refGath : CR.Nm2RefMp- alternatives:- alternative AGItf:- child module : CModule --}--- cata-sem_CodeAGItf :: CodeAGItf ->- T_CodeAGItf-sem_CodeAGItf (CodeAGItf_AGItf _module) =- (sem_CodeAGItf_AGItf (sem_CModule _module))--- semantic domain-type T_CodeAGItf = Int ->- (CR.Nm2RefMp) ->- EHCOpts ->- ( (CR.Mod),(CR.Nm2RefMp))-data Inh_CodeAGItf = Inh_CodeAGItf {modNr_Inh_CodeAGItf :: !(Int),nm2ref_Inh_CodeAGItf :: !((CR.Nm2RefMp)),opts_Inh_CodeAGItf :: !(EHCOpts)}-data Syn_CodeAGItf = Syn_CodeAGItf {crm_Syn_CodeAGItf :: !((CR.Mod)),nm2refGath_Syn_CodeAGItf :: !((CR.Nm2RefMp))}-wrap_CodeAGItf :: T_CodeAGItf ->- Inh_CodeAGItf ->- Syn_CodeAGItf-wrap_CodeAGItf sem (Inh_CodeAGItf _lhsImodNr _lhsInm2ref _lhsIopts) =- (let ( _lhsOcrm,_lhsOnm2refGath) = sem _lhsImodNr _lhsInm2ref _lhsIopts- in (Syn_CodeAGItf _lhsOcrm _lhsOnm2refGath))-sem_CodeAGItf_AGItf :: T_CModule ->- T_CodeAGItf-sem_CodeAGItf_AGItf module_ =- (\ _lhsImodNr- _lhsInm2ref- _lhsIopts ->- (case (_lhsInm2ref) of- { _moduleOnm2ref ->- (case (_lhsImodNr) of- { _moduleOmodNr ->- (case (cLevModule) of- { _moduleOlev ->- (case (_lhsIopts) of- { _moduleOopts ->- (case (module_ _moduleOlev _moduleOmodNr _moduleOnm2ref _moduleOopts) of- { ( _moduleIcrm,_moduleInm2refGath) ->- (case (_moduleIcrm) of- { _lhsOcrm ->- (case (_moduleInm2refGath) of- { _lhsOnm2refGath ->- ( _lhsOcrm,_lhsOnm2refGath) }) }) }) }) }) }) }))+module UHC.Light.Compiler.Core.ToCoreRun(Inh_CodeAGItf (..), Syn_CodeAGItf (..), wrap_CodeAGItf, sem_CodeAGItf+, cmod2CoreRun', cmod2CoreRunWithModNr, cmod2CoreRun) where++import UHC.Light.Compiler.Base.Common+import UHC.Light.Compiler.Base.TermLike+import UHC.Light.Compiler.Opts+import UHC.Light.Compiler.Ty+import UHC.Light.Compiler.Core+import Data.Maybe+import qualified Data.Map as Map+import Data.Char+import Data.List+import UHC.Util.Utils+import qualified UHC.Util.RelMap as Rel+import qualified UHC.Util.FastSeq as Seq+import UHC.Light.Compiler.Base.HsName.Builtin+import UHC.Light.Compiler.CodeGen.BuiltinSizeInfo+import UHC.Light.Compiler.CodeGen.BuiltinPrims+import UHC.Light.Compiler.CodeGen.BasicAnnot+import qualified UHC.Light.Compiler.CoreRun as CR+import qualified UHC.Light.Compiler.CoreRun.API as CR+import qualified UHC.Light.Compiler.CoreRun.Prim as CR+import UHC.Light.Compiler.Foreign.Extract++++++++++++++++++++++-- | Translate to CoreRun+cmod2CoreRun'+ :: EHCOpts+ -> Bool -- ^ has main?+ -> Int -- ^ sequence nr of module (offset), used to create global per module references+ -> CR.Nm2RefMp -- ^ outer bindings+ -> CModule+ -> ( CR.Mod -- generated CoreRun+ , CR.Nm2RefMp -- name to ref mapping of toplevel bindings+ , Syn_CodeAGItf -- the 2 above, for now duplicate+ )+cmod2CoreRun' opts hasMain modNr nm2ref cmod+ = ( crm_Syn_CodeAGItf t+ , nm2refGath_Syn_CodeAGItf t+ , t+ )+ where t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf cmod))+ (Inh_CodeAGItf+ { modNr_Inh_CodeAGItf = modNr+ , opts_Inh_CodeAGItf = opts+ , hasMain_Inh_CodeAGItf = hasMain+ , nm2ref_Inh_CodeAGItf = nm2ref+ })++cmod2CoreRunWithModNr :: Int -> CModule -> CR.Mod+cmod2CoreRunWithModNr nr m = m'+ where (m',_,_) = cmod2CoreRun' defaultEHCOpts True nr CR.emptyNm2RefMp m++cmod2CoreRun :: CModule -> CR.Mod+cmod2CoreRun = cmod2CoreRunWithModNr 0++++-- | What to do with binding in terms of thunking/forcing?+data ToBe+ = ToBe_Thunked+ | ToBe_Forced+ | ToBe_LeftAsIs+ deriving Eq++++-- | Tail context+data TailCtx+ = TailCtx_Plain+ | TailCtx_TailCall+ | TailCtx_CaseAlt++tailCtxIsTailRec :: TailCtx -> Bool+tailCtxIsTailRec TailCtx_TailCall = True+tailCtxIsTailRec _ = False++-- | Wrap according to tail context+cseCtxWrap :: TailCtx -> CR.Exp -> CR.Exp+cseCtxWrap TailCtx_TailCall = CR.mkTail+cseCtxWrap _ = id++++-- | Construct application+mkApp :: CR.Exp -> CR.CRArray CR.SExp -> CR.Exp+mkApp f as = CR.mkApp' (CR.mkEval f) as++++-- | Wrap context saving if not at tail recursive position+tailrec :: TailCtx -> CR.Exp -> CR.Exp+tailrec tailCtx = if tailCtxIsTailRec tailCtx then id else id -- CR.Exp_Ret -- id++-- | Wrap forcing if at tail recursive position+taileval :: TailCtx -> CR.Exp -> CR.Exp+taileval tailCtx = if tailCtxIsTailRec tailCtx then CR.mkEval else id++-- CAlt --------------------------------------------------------+{-+ visit 0:+ chained attribute:+ refOffset : Int+ visit 1:+ inherited attributes:+ evalCtx : EvalCtx+ impNmLkup : HsName -> Maybe Int+ lev : Int+ modNr : Int+ nm2ref : CR.Nm2RefMp+ opts : EHCOpts+ scrutRef : CR.RRef+ tailCtx : TailCtx+ chained attribute:+ stackDepth : Int+ synthesized attributes:+ cra : [CR.Alt]+ refOffsetMax : Int+ stackDepthMax : Int+ alternatives:+ alternative Alt:+ child pat : CPat + child expr : CExpr + visit 1:+ local whatAbove : {WhatExpr}+ local nm2refNew : _+-}+-- cata+sem_CAlt :: CAlt ->+ T_CAlt+sem_CAlt (CAlt_Alt _pat _expr) =+ (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr))+-- semantic domain+type T_CAlt = Int ->+ ( Int,T_CAlt_1)+type T_CAlt_1 = EvalCtx ->+ (HsName -> Maybe Int) ->+ Int ->+ Int ->+ (CR.Nm2RefMp) ->+ EHCOpts ->+ (CR.RRef) ->+ Int ->+ TailCtx ->+ ( ([CR.Alt]),Int,Int,Int)+sem_CAlt_Alt :: T_CPat ->+ T_CExpr ->+ T_CAlt+sem_CAlt_Alt pat_ expr_ =+ (\ _lhsIrefOffset ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CAlt_Alt_1 :: T_CAlt_1+ sem_CAlt_Alt_1 =+ (\ _lhsIevalCtx+ _lhsIimpNmLkup+ _lhsIlev+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIscrutRef+ _lhsIstackDepth+ _lhsItailCtx ->+ (case (ExprIsOther) of+ { _whatAbove ->+ (case (_whatAbove) of+ { _exprOwhatAbove ->+ (case (_lhsItailCtx) of+ { _exprOtailCtx ->+ (case (_lhsIlev) of+ { _exprOlev ->+ (case (_lhsIimpNmLkup) of+ { _exprOimpNmLkup ->+ (case (_lhsIstackDepth) of+ { _patOstackDepth ->+ (case (_lhsIrefOffset) of+ { _patOrefOffset ->+ (case (_lhsIopts) of+ { _patOopts ->+ (case (_lhsInm2ref) of+ { _patOnm2ref ->+ (case (_lhsImodNr) of+ { _patOmodNr ->+ (case (_lhsIlev) of+ { _patOlev ->+ (case (_lhsIimpNmLkup) of+ { _patOimpNmLkup ->+ (case (pat_ _patOimpNmLkup _patOlev _patOmodNr _patOnm2ref _patOopts _patOrefOffset _patOstackDepth) of+ { ( _patIcrp,_patIfldNmL,_patIrefOffset,_patIstackDepth) ->+ (case (Rel.fromList [ (n, CR.RRef_Fld _lhsIscrutRef i) | (n,i) <- zip _patIfldNmL [0..] ]) of+ { _nm2refNew ->+ (case (_nm2refNew `CR.nm2refUnion` _lhsInm2ref) of+ { _exprOnm2ref ->+ (case (_lhsIstackDepth) of+ { _exprOstackDepth ->+ (case (_lhsIrefOffset) of+ { _exprOrefOffset ->+ (case (expr_) of+ { ( _exprIwhatBelow,expr_1) ->+ (case (expr_1 _exprOlev _exprOrefOffset _exprOwhatAbove) of+ { ( _exprInm2refGath,_exprIrefOffset,expr_2) ->+ (case (_lhsIopts) of+ { _exprOopts ->+ (case (_lhsImodNr) of+ { _exprOmodNr ->+ (case (_lhsIevalCtx) of+ { _exprOevalCtx ->+ (case (True) of+ { _exprOisTopTup ->+ (case (True) of+ { _exprOisTopApp ->+ (case (expr_2 _exprOevalCtx _exprOimpNmLkup _exprOisTopApp _exprOisTopTup _exprOmodNr _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of+ { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax,_exprIvref) ->+ (case ([CR.Alt_Alt (CR.nm2RefMpInverse _nm2refNew) _exprIcre]) of+ { _lhsOcra ->+ (case (max _exprIrefOffset _exprIrefOffsetMax) of+ { _lhsOrefOffsetMax ->+ (case (_lhsIstackDepth) of+ { _lhsOstackDepth ->+ (case (max _exprIstackDepth _exprIstackDepthMax) of+ { _lhsOstackDepthMax ->+ ( _lhsOcra,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CAlt_Alt_1)) of+ { ( sem_CAlt_1) ->+ ( _lhsOrefOffset,sem_CAlt_1) }) }))+-- CAltL -------------------------------------------------------+{-+ visit 0:+ chained attribute:+ refOffset : Int+ visit 1:+ inherited attributes:+ evalCtx : EvalCtx+ impNmLkup : HsName -> Maybe Int+ lev : Int+ modNr : Int+ nm2ref : CR.Nm2RefMp+ opts : EHCOpts+ scrutRef : CR.RRef+ tailCtx : TailCtx+ chained attribute:+ stackDepth : Int+ synthesized attributes:+ cra : [CR.Alt]+ refOffsetMax : Int+ stackDepthMax : Int+ alternatives:+ alternative Cons:+ child hd : CAlt + child tl : CAltL + alternative Nil:+-}+-- cata+sem_CAltL :: CAltL ->+ T_CAltL+sem_CAltL list =+ (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list))+-- semantic domain+type T_CAltL = Int ->+ ( Int,T_CAltL_1)+type T_CAltL_1 = EvalCtx ->+ (HsName -> Maybe Int) ->+ Int ->+ Int ->+ (CR.Nm2RefMp) ->+ EHCOpts ->+ (CR.RRef) ->+ Int ->+ TailCtx ->+ ( ([CR.Alt]),Int,Int,Int)+sem_CAltL_Cons :: T_CAlt ->+ T_CAltL ->+ T_CAltL+sem_CAltL_Cons hd_ tl_ =+ (\ _lhsIrefOffset ->+ (case (_lhsIrefOffset) of+ { _hdOrefOffset ->+ (case (hd_ _hdOrefOffset) of+ { ( _hdIrefOffset,hd_1) ->+ (case (_hdIrefOffset) of+ { _tlOrefOffset ->+ (case (tl_ _tlOrefOffset) of+ { ( _tlIrefOffset,tl_1) ->+ (case (_tlIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CAltL_Cons_1 :: T_CAltL_1+ sem_CAltL_Cons_1 =+ (\ _lhsIevalCtx+ _lhsIimpNmLkup+ _lhsIlev+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIscrutRef+ _lhsIstackDepth+ _lhsItailCtx ->+ (case (_lhsItailCtx) of+ { _tlOtailCtx ->+ (case (_lhsIstackDepth) of+ { _hdOstackDepth ->+ (case (_lhsItailCtx) of+ { _hdOtailCtx ->+ (case (_lhsIscrutRef) of+ { _hdOscrutRef ->+ (case (_lhsIopts) of+ { _hdOopts ->+ (case (_lhsInm2ref) of+ { _hdOnm2ref ->+ (case (_lhsImodNr) of+ { _hdOmodNr ->+ (case (_lhsIlev) of+ { _hdOlev ->+ (case (_lhsIimpNmLkup) of+ { _hdOimpNmLkup ->+ (case (_lhsIevalCtx) of+ { _hdOevalCtx ->+ (case (hd_1 _hdOevalCtx _hdOimpNmLkup _hdOlev _hdOmodNr _hdOnm2ref _hdOopts _hdOscrutRef _hdOstackDepth _hdOtailCtx) of+ { ( _hdIcra,_hdIrefOffsetMax,_hdIstackDepth,_hdIstackDepthMax) ->+ (case (_hdIstackDepth) of+ { _tlOstackDepth ->+ (case (_lhsIscrutRef) of+ { _tlOscrutRef ->+ (case (_lhsInm2ref) of+ { _tlOnm2ref ->+ (case (_lhsIlev) of+ { _tlOlev ->+ (case (_lhsIimpNmLkup) of+ { _tlOimpNmLkup ->+ (case (_lhsIopts) of+ { _tlOopts ->+ (case (_lhsImodNr) of+ { _tlOmodNr ->+ (case (_lhsIevalCtx) of+ { _tlOevalCtx ->+ (case (tl_1 _tlOevalCtx _tlOimpNmLkup _tlOlev _tlOmodNr _tlOnm2ref _tlOopts _tlOscrutRef _tlOstackDepth _tlOtailCtx) of+ { ( _tlIcra,_tlIrefOffsetMax,_tlIstackDepth,_tlIstackDepthMax) ->+ (case (_hdIcra ++ _tlIcra) of+ { _lhsOcra ->+ (case (_hdIrefOffsetMax `max` _tlIrefOffsetMax) of+ { _lhsOrefOffsetMax ->+ (case (_tlIstackDepth) of+ { _lhsOstackDepth ->+ (case (_hdIstackDepthMax `max` _tlIstackDepthMax) of+ { _lhsOstackDepthMax ->+ ( _lhsOcra,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CAltL_Cons_1)) of+ { ( sem_CAltL_1) ->+ ( _lhsOrefOffset,sem_CAltL_1) }) }) }) }) }) }))+sem_CAltL_Nil :: T_CAltL+sem_CAltL_Nil =+ (\ _lhsIrefOffset ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CAltL_Nil_1 :: T_CAltL_1+ sem_CAltL_Nil_1 =+ (\ _lhsIevalCtx+ _lhsIimpNmLkup+ _lhsIlev+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIscrutRef+ _lhsIstackDepth+ _lhsItailCtx ->+ (case ([]) of+ { _lhsOcra ->+ (case (0) of+ { _lhsOrefOffsetMax ->+ (case (_lhsIstackDepth) of+ { _lhsOstackDepth ->+ (case (0) of+ { _lhsOstackDepthMax ->+ ( _lhsOcra,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }))+ in sem_CAltL_Nil_1)) of+ { ( sem_CAltL_1) ->+ ( _lhsOrefOffset,sem_CAltL_1) }) }))+-- CBind -------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ isGlobal : Bool+ lev : Int+ chained attribute:+ refOffset : Int+ synthesized attributes:+ nm : HsName+ nm2refGath : CR.Nm2RefMp+ visit 1:+ inherited attributes:+ evalCtx : EvalCtx+ impNmLkup : HsName -> Maybe Int+ letBindingsCateg : CBindCateg+ modNr : Int+ nm2ref : CR.Nm2RefMp+ opts : EHCOpts+ chained attribute:+ stackDepth : Int+ synthesized attributes:+ crb : [(HsName, CR.Bind)]+ refOffsetMax : Int+ stackDepthMax : Int+ alternatives:+ alternative Bind:+ child nm : {HsName}+ child bindAspects : CBoundL + visit 0:+ local ref : _+ local nm2refGath : _+ local refOffsetHere : _+ visit 1:+ local crb : _+-}+-- cata+sem_CBind :: CBind ->+ T_CBind+sem_CBind (CBind_Bind _nm _bindAspects) =+ (sem_CBind_Bind _nm (sem_CBoundL _bindAspects))+-- semantic domain+type T_CBind = Bool ->+ Int ->+ Int ->+ ( HsName,(CR.Nm2RefMp),Int,T_CBind_1)+type T_CBind_1 = EvalCtx ->+ (HsName -> Maybe Int) ->+ CBindCateg ->+ Int ->+ (CR.Nm2RefMp) ->+ EHCOpts ->+ Int ->+ ( ([(HsName, CR.Bind)]),Int,Int,Int)+sem_CBind_Bind :: HsName ->+ T_CBoundL ->+ T_CBind+sem_CBind_Bind nm_ bindAspects_ =+ (\ _lhsIisGlobal+ _lhsIlev+ _lhsIrefOffset ->+ (case (nm_) of+ { _lhsOnm ->+ (case (if _lhsIisGlobal+ then CR.RRef_Mod _lhsIrefOffset+ else CR.RRef_Loc _lhsIlev _lhsIrefOffset) of+ { _ref ->+ (case (Rel.singleton nm_ _ref) of+ { _nm2refGath ->+ (case (_nm2refGath) of+ { _lhsOnm2refGath ->+ (case (_lhsIrefOffset + 1) of+ { _refOffsetHere ->+ (case (_refOffsetHere) of+ { _lhsOrefOffset ->+ (case ((let sem_CBind_Bind_1 :: T_CBind_1+ sem_CBind_Bind_1 =+ (\ _lhsIevalCtx+ _lhsIimpNmLkup+ _lhsIletBindingsCateg+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth ->+ (case (_lhsIstackDepth) of+ { _bindAspectsOstackDepth ->+ (case (_lhsIrefOffset) of+ { _bindAspectsOrefOffset ->+ (case (_lhsInm2ref) of+ { _bindAspectsOnm2ref ->+ (case (_lhsIlev) of+ { _bindAspectsOlev ->+ (case (_lhsIisGlobal) of+ { _bindAspectsOisGlobal ->+ (case (_lhsIimpNmLkup) of+ { _bindAspectsOimpNmLkup ->+ (case (_lhsIevalCtx) of+ { _bindAspectsOevalCtx ->+ (case (nm_) of+ { _bindAspectsOnm ->+ (case (_lhsIopts) of+ { _bindAspectsOopts ->+ (case (_lhsImodNr) of+ { _bindAspectsOmodNr ->+ (case (_lhsIletBindingsCateg) of+ { _bindAspectsOletBindingsCateg ->+ (case (bindAspects_ _bindAspectsOevalCtx _bindAspectsOimpNmLkup _bindAspectsOisGlobal _bindAspectsOletBindingsCateg _bindAspectsOlev _bindAspectsOmodNr _bindAspectsOnm _bindAspectsOnm2ref _bindAspectsOopts _bindAspectsOrefOffset _bindAspectsOstackDepth) of+ { ( _bindAspectsIcrb,_bindAspectsInm2refGath,_bindAspectsIrefOffset,_bindAspectsIrefOffsetMax,_bindAspectsIstackDepth,_bindAspectsIstackDepthMax) ->+ (case (take 1 _bindAspectsIcrb) of+ { _crb ->+ (case (_crb) of+ { _lhsOcrb ->+ (case (_bindAspectsIrefOffsetMax) of+ { _lhsOrefOffsetMax ->+ (case (_bindAspectsIstackDepth) of+ { _lhsOstackDepth ->+ (case (_bindAspectsIstackDepthMax) of+ { _lhsOstackDepthMax ->+ ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CBind_Bind_1)) of+ { ( sem_CBind_1) ->+ ( _lhsOnm,_lhsOnm2refGath,_lhsOrefOffset,sem_CBind_1) }) }) }) }) }) }) }))+-- CBindAnn ----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ impNmLkup : HsName -> Maybe Int+ lev : Int+ modNr : Int+ nm2ref : CR.Nm2RefMp+ opts : EHCOpts+ chained attributes:+ refOffset : Int+ stackDepth : Int+ alternatives:+ alternative Coe:+ child coe : {RelevCoe}+-}+-- cata+sem_CBindAnn :: CBindAnn ->+ T_CBindAnn+sem_CBindAnn (CBindAnn_Coe _coe) =+ (sem_CBindAnn_Coe _coe)+-- semantic domain+type T_CBindAnn = (HsName -> Maybe Int) ->+ Int ->+ Int ->+ (CR.Nm2RefMp) ->+ EHCOpts ->+ Int ->+ Int ->+ ( Int,Int)+sem_CBindAnn_Coe :: RelevCoe ->+ T_CBindAnn+sem_CBindAnn_Coe coe_ =+ (\ _lhsIimpNmLkup+ _lhsIlev+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIrefOffset+ _lhsIstackDepth ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case (_lhsIstackDepth) of+ { _lhsOstackDepth ->+ ( _lhsOrefOffset,_lhsOstackDepth) }) }))+-- CBindAnnL ---------------------------------------------------+{-+ visit 0:+ inherited attributes:+ impNmLkup : HsName -> Maybe Int+ lev : Int+ modNr : Int+ nm2ref : CR.Nm2RefMp+ opts : EHCOpts+ chained attributes:+ refOffset : Int+ stackDepth : Int+ alternatives:+ alternative Cons:+ child hd : CBindAnn + child tl : CBindAnnL + alternative Nil:+-}+-- cata+sem_CBindAnnL :: CBindAnnL ->+ T_CBindAnnL+sem_CBindAnnL list =+ (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list))+-- semantic domain+type T_CBindAnnL = (HsName -> Maybe Int) ->+ Int ->+ Int ->+ (CR.Nm2RefMp) ->+ EHCOpts ->+ Int ->+ Int ->+ ( Int,Int)+sem_CBindAnnL_Cons :: T_CBindAnn ->+ T_CBindAnnL ->+ T_CBindAnnL+sem_CBindAnnL_Cons hd_ tl_ =+ (\ _lhsIimpNmLkup+ _lhsIlev+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIrefOffset+ _lhsIstackDepth ->+ (case (_lhsIrefOffset) of+ { _hdOrefOffset ->+ (case (_lhsIstackDepth) of+ { _hdOstackDepth ->+ (case (_lhsIopts) of+ { _hdOopts ->+ (case (_lhsInm2ref) of+ { _hdOnm2ref ->+ (case (_lhsImodNr) of+ { _hdOmodNr ->+ (case (_lhsIlev) of+ { _hdOlev ->+ (case (_lhsIimpNmLkup) of+ { _hdOimpNmLkup ->+ (case (hd_ _hdOimpNmLkup _hdOlev _hdOmodNr _hdOnm2ref _hdOopts _hdOrefOffset _hdOstackDepth) of+ { ( _hdIrefOffset,_hdIstackDepth) ->+ (case (_hdIrefOffset) of+ { _tlOrefOffset ->+ (case (_hdIstackDepth) of+ { _tlOstackDepth ->+ (case (_lhsIopts) of+ { _tlOopts ->+ (case (_lhsInm2ref) of+ { _tlOnm2ref ->+ (case (_lhsImodNr) of+ { _tlOmodNr ->+ (case (_lhsIlev) of+ { _tlOlev ->+ (case (_lhsIimpNmLkup) of+ { _tlOimpNmLkup ->+ (case (tl_ _tlOimpNmLkup _tlOlev _tlOmodNr _tlOnm2ref _tlOopts _tlOrefOffset _tlOstackDepth) of+ { ( _tlIrefOffset,_tlIstackDepth) ->+ (case (_tlIrefOffset) of+ { _lhsOrefOffset ->+ (case (_tlIstackDepth) of+ { _lhsOstackDepth ->+ ( _lhsOrefOffset,_lhsOstackDepth) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+sem_CBindAnnL_Nil :: T_CBindAnnL+sem_CBindAnnL_Nil =+ (\ _lhsIimpNmLkup+ _lhsIlev+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIrefOffset+ _lhsIstackDepth ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case (_lhsIstackDepth) of+ { _lhsOstackDepth ->+ ( _lhsOrefOffset,_lhsOstackDepth) }) }))+-- CBindL ------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ isGlobal : Bool+ lev : Int+ chained attribute:+ refOffset : Int+ synthesized attribute:+ nm2refGath : CR.Nm2RefMp+ visit 1:+ inherited attributes:+ evalCtx : EvalCtx+ impNmLkup : HsName -> Maybe Int+ letBindingsCateg : CBindCateg+ modNr : Int+ nm2ref : CR.Nm2RefMp+ opts : EHCOpts+ chained attribute:+ stackDepth : Int+ synthesized attributes:+ crb : [(HsName, CR.Bind)]+ refOffsetMax : Int+ stackDepthMax : Int+ alternatives:+ alternative Cons:+ child hd : CBind + child tl : CBindL + alternative Nil:+-}+-- cata+sem_CBindL :: CBindL ->+ T_CBindL+sem_CBindL list =+ (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list))+-- semantic domain+type T_CBindL = Bool ->+ Int ->+ Int ->+ ( (CR.Nm2RefMp),Int,T_CBindL_1)+type T_CBindL_1 = EvalCtx ->+ (HsName -> Maybe Int) ->+ CBindCateg ->+ Int ->+ (CR.Nm2RefMp) ->+ EHCOpts ->+ Int ->+ ( ([(HsName, CR.Bind)]),Int,Int,Int)+sem_CBindL_Cons :: T_CBind ->+ T_CBindL ->+ T_CBindL+sem_CBindL_Cons hd_ tl_ =+ (\ _lhsIisGlobal+ _lhsIlev+ _lhsIrefOffset ->+ (case (_lhsIrefOffset) of+ { _hdOrefOffset ->+ (case (_lhsIlev) of+ { _hdOlev ->+ (case (_lhsIisGlobal) of+ { _hdOisGlobal ->+ (case (hd_ _hdOisGlobal _hdOlev _hdOrefOffset) of+ { ( _hdInm,_hdInm2refGath,_hdIrefOffset,hd_1) ->+ (case (_hdIrefOffset) of+ { _tlOrefOffset ->+ (case (_lhsIlev) of+ { _tlOlev ->+ (case (_lhsIisGlobal) of+ { _tlOisGlobal ->+ (case (tl_ _tlOisGlobal _tlOlev _tlOrefOffset) of+ { ( _tlInm2refGath,_tlIrefOffset,tl_1) ->+ (case (_hdInm2refGath `CR.nm2refUnion` _tlInm2refGath) of+ { _lhsOnm2refGath ->+ (case (_tlIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CBindL_Cons_1 :: T_CBindL_1+ sem_CBindL_Cons_1 =+ (\ _lhsIevalCtx+ _lhsIimpNmLkup+ _lhsIletBindingsCateg+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth ->+ (case (_lhsIstackDepth) of+ { _hdOstackDepth ->+ (case (_lhsIevalCtx) of+ { _hdOevalCtx ->+ (case (_lhsIopts) of+ { _hdOopts ->+ (case (_lhsInm2ref) of+ { _hdOnm2ref ->+ (case (_lhsImodNr) of+ { _hdOmodNr ->+ (case (_lhsIletBindingsCateg) of+ { _hdOletBindingsCateg ->+ (case (_lhsIimpNmLkup) of+ { _hdOimpNmLkup ->+ (case (hd_1 _hdOevalCtx _hdOimpNmLkup _hdOletBindingsCateg _hdOmodNr _hdOnm2ref _hdOopts _hdOstackDepth) of+ { ( _hdIcrb,_hdIrefOffsetMax,_hdIstackDepth,_hdIstackDepthMax) ->+ (case (_hdIstackDepth) of+ { _tlOstackDepth ->+ (case (_lhsInm2ref) of+ { _tlOnm2ref ->+ (case (_lhsIimpNmLkup) of+ { _tlOimpNmLkup ->+ (case (_lhsIevalCtx) of+ { _tlOevalCtx ->+ (case (_lhsIopts) of+ { _tlOopts ->+ (case (_lhsImodNr) of+ { _tlOmodNr ->+ (case (_lhsIletBindingsCateg) of+ { _tlOletBindingsCateg ->+ (case (tl_1 _tlOevalCtx _tlOimpNmLkup _tlOletBindingsCateg _tlOmodNr _tlOnm2ref _tlOopts _tlOstackDepth) of+ { ( _tlIcrb,_tlIrefOffsetMax,_tlIstackDepth,_tlIstackDepthMax) ->+ (case (_hdIcrb ++ _tlIcrb) of+ { _lhsOcrb ->+ (case (_hdIrefOffsetMax `max` _tlIrefOffsetMax) of+ { _lhsOrefOffsetMax ->+ (case (_tlIstackDepth) of+ { _lhsOstackDepth ->+ (case (_hdIstackDepthMax `max` _tlIstackDepthMax) of+ { _lhsOstackDepthMax ->+ ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CBindL_Cons_1)) of+ { ( sem_CBindL_1) ->+ ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBindL_1) }) }) }) }) }) }) }) }) }) }) }))+sem_CBindL_Nil :: T_CBindL+sem_CBindL_Nil =+ (\ _lhsIisGlobal+ _lhsIlev+ _lhsIrefOffset ->+ (case (CR.emptyNm2RefMp) of+ { _lhsOnm2refGath ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CBindL_Nil_1 :: T_CBindL_1+ sem_CBindL_Nil_1 =+ (\ _lhsIevalCtx+ _lhsIimpNmLkup+ _lhsIletBindingsCateg+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth ->+ (case ([]) of+ { _lhsOcrb ->+ (case (0) of+ { _lhsOrefOffsetMax ->+ (case (_lhsIstackDepth) of+ { _lhsOstackDepth ->+ (case (0) of+ { _lhsOstackDepthMax ->+ ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }))+ in sem_CBindL_Nil_1)) of+ { ( sem_CBindL_1) ->+ ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBindL_1) }) }) }))+-- CBound ------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ evalCtx : EvalCtx+ isGlobal : Bool+ lev : Int+ nm : HsName+ chained attribute:+ refOffset : Int+ synthesized attribute:+ nm2refGath : CR.Nm2RefMp+ visit 1:+ inherited attributes:+ impNmLkup : HsName -> Maybe Int+ isTopApp : Bool+ isTopTup : Bool+ letBindingsCateg : CBindCateg+ modNr : Int+ nm2ref : CR.Nm2RefMp+ opts : EHCOpts+ chained attribute:+ stackDepth : Int+ synthesized attributes:+ crb : [(HsName, CR.Bind)]+ refOffsetMax : Int+ stackDepthMax : Int+ alternatives:+ alternative Bind:+ child bindMeta : CMetas + child expr : CExpr + visit 0:+ local whatAbove : {WhatExpr}+ local toBe : _+ local isToBeThunked : _+ local lev : _+ local refOffsetExpr : _+ visit 1:+ local tailCtx : _+ local nm2refNew : _+ local isToBeALam : _+ local stackDepthMaxThunked : _+ local creMkForce : _+ local creBind : _+ local crb : _+ local stackDepthExpr : _+ intra isToBeThunked : _+ intra toBe : _+ alternative Meta:+ child aspectKeyS : {ACoreBindAspectKeyS}+ child cmetas : CMetas + alternative RelevTy:+ child aspectKeyS : {ACoreBindAspectKeyS}+ child relevTy : {RelevTy}+ alternative Val:+ child aspectKeyS : {ACoreBindAspectKeyS}+ child mlev : {MetaLev}+ child lbl : {CLbl}+ child expr : CExpr + visit 0:+ local whatAbove : {WhatExpr}+ local toBe : _+ local isToBeThunked : _+ local lev : _+ local refOffsetExpr : _+ visit 1:+ local tailCtx : _+ local nm2refNew : _+ local isToBeALam : _+ local stackDepthMaxThunked : _+ local creMkForce : _+ local creBind : _+ local crb : _+ local stackDepthExpr : _+ intra isToBeThunked : _+ intra toBe : _+ alternative Ty:+ child aspectKeyS : {ACoreBindAspectKeyS}+ child ty : {Ty}+ alternative FFE:+ child callconv : {FFIWay}+ child expEnt : {ForeignEnt}+ child expr : CExpr + child ty : {Ty}+ visit 0:+ local whatAbove : {WhatExpr}+ visit 1:+ local tailCtx : _+-}+-- cata+sem_CBound :: CBound ->+ T_CBound+sem_CBound (CBound_Bind _bindMeta _expr) =+ (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr))+sem_CBound (CBound_Meta _aspectKeyS _cmetas) =+ (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas))+sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) =+ (sem_CBound_RelevTy _aspectKeyS _relevTy)+sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) =+ (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr))+sem_CBound (CBound_Ty _aspectKeyS _ty) =+ (sem_CBound_Ty _aspectKeyS _ty)+sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) =+ (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty)+-- semantic domain+type T_CBound = EvalCtx ->+ Bool ->+ Int ->+ HsName ->+ Int ->+ ( (CR.Nm2RefMp),Int,T_CBound_1)+type T_CBound_1 = (HsName -> Maybe Int) ->+ Bool ->+ Bool ->+ CBindCateg ->+ Int ->+ (CR.Nm2RefMp) ->+ EHCOpts ->+ Int ->+ ( ([(HsName, CR.Bind)]),Int,Int,Int)+sem_CBound_Bind :: T_CMetas ->+ T_CExpr ->+ T_CBound+sem_CBound_Bind bindMeta_ expr_ =+ (\ _lhsIevalCtx+ _lhsIisGlobal+ _lhsIlev+ _lhsInm+ _lhsIrefOffset ->+ (case (ExprIsBind _lhsInm) of+ { _whatAbove ->+ (case (_whatAbove) of+ { _exprOwhatAbove ->+ (case (expr_) of+ { ( _exprIwhatBelow,expr_1) ->+ (case (let mba@(~(Just (_,w))) = whatExprMbApp _exprIwhatBelow+ isVar = isJust $ whatExprMbVar _exprIwhatBelow+ isGlbVar = isVar && _lhsIisGlobal+ isApp = isJust mba+ isTup = isApp && whatExprIsTup w+ isWHNF = whatExprIsWHNF _exprIwhatBelow+ isNotWHNF = not isWHNF+ in case _lhsIevalCtx of+ EvalCtx_Eval+ | isApp -> ToBe_LeftAsIs+ | isVar -> ToBe_Forced+ | isNotWHNF -> ToBe_Forced+ EvalCtx_Thunk+ | isTup -> ToBe_LeftAsIs+ | isGlbVar -> ToBe_Thunked+ | isNotWHNF -> ToBe_Thunked+ _ -> ToBe_LeftAsIs) of+ { _toBe ->+ (case (_toBe == ToBe_Thunked) of+ { _isToBeThunked ->+ (case (if _isToBeThunked then _lhsIlev + 1 else _lhsIlev) of+ { _lev ->+ (case (_lev) of+ { _exprOlev ->+ (case (if _isToBeThunked then 0 else _lhsIrefOffset) of+ { _refOffsetExpr ->+ (case (_refOffsetExpr) of+ { _exprOrefOffset ->+ (case (expr_1 _exprOlev _exprOrefOffset _exprOwhatAbove) of+ { ( _exprInm2refGath,_exprIrefOffset,expr_2) ->+ (case (_exprInm2refGath) of+ { _lhsOnm2refGath ->+ (case (if _isToBeThunked then _lhsIrefOffset else _exprIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CBound_Bind_1 :: T_CBound_1+ sem_CBound_Bind_1 =+ (\ _lhsIimpNmLkup+ _lhsIisTopApp+ _lhsIisTopTup+ _lhsIletBindingsCateg+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth ->+ (case (if _isToBeThunked then TailCtx_TailCall else TailCtx_Plain) of+ { _tailCtx ->+ (case (_tailCtx) of+ { _exprOtailCtx ->+ (case (_lhsInm2ref) of+ { _exprOnm2ref ->+ (case (_lhsIimpNmLkup) of+ { _exprOimpNmLkup ->+ (case (if _isToBeThunked then _exprInm2refGath else CR.emptyNm2RefMp) of+ { _nm2refNew ->+ (case (_isToBeThunked || whatExprIsLam _exprIwhatBelow) of+ { _isToBeALam ->+ (case (if _isToBeALam then 0 else _lhsIstackDepth) of+ { _exprOstackDepth ->+ (case (_lhsIopts) of+ { _exprOopts ->+ (case (_lhsImodNr) of+ { _exprOmodNr ->+ (case (_lhsIevalCtx) of+ { _exprOevalCtx ->+ (case (True) of+ { _exprOisTopTup ->+ (case (True) of+ { _exprOisTopApp ->+ (case (expr_2 _exprOevalCtx _exprOimpNmLkup _exprOisTopApp _exprOisTopTup _exprOmodNr _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of+ { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax,_exprIvref) ->+ (case (max _exprIstackDepth _exprIstackDepthMax) of+ { _stackDepthMaxThunked ->+ (case (case _toBe of+ ToBe_Forced -> tailrec _tailCtx . CR.mkEval+ ToBe_Thunked -> CR.Exp_Lam (Just _lhsInm) 0 (_stackDepthMaxThunked) (CR.nm2RefMpInverse _nm2refNew)+ ToBe_LeftAsIs -> id) of+ { _creMkForce ->+ (case (_creMkForce _exprIcre) of+ { _creBind ->+ (case ([( _lhsInm, _creBind )]) of+ { _crb ->+ (case (_crb) of+ { _lhsOcrb ->+ (case (if _isToBeThunked then _lhsIrefOffset else max _exprIrefOffset _exprIrefOffsetMax) of+ { _lhsOrefOffsetMax ->+ (case (if _isToBeALam then _lhsIstackDepth+1 else _exprIstackDepth) of+ { _stackDepthExpr ->+ (case (_stackDepthExpr) of+ { _lhsOstackDepth ->+ (case (if _isToBeALam then _stackDepthExpr else _stackDepthMaxThunked) of+ { _lhsOstackDepthMax ->+ ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CBound_Bind_1)) of+ { ( sem_CBound_1) ->+ ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBound_1) }) }) }) }) }) }) }) }) }) }) }) }) }))+sem_CBound_Meta :: ACoreBindAspectKeyS ->+ T_CMetas ->+ T_CBound+sem_CBound_Meta aspectKeyS_ cmetas_ =+ (\ _lhsIevalCtx+ _lhsIisGlobal+ _lhsIlev+ _lhsInm+ _lhsIrefOffset ->+ (case (CR.emptyNm2RefMp) of+ { _lhsOnm2refGath ->+ (case (_lhsIrefOffset) of+ { _cmetasOrefOffset ->+ (case (cmetas_ _cmetasOrefOffset) of+ { ( _cmetasIrefOffset,cmetas_1) ->+ (case (_cmetasIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CBound_Meta_1 :: T_CBound_1+ sem_CBound_Meta_1 =+ (\ _lhsIimpNmLkup+ _lhsIisTopApp+ _lhsIisTopTup+ _lhsIletBindingsCateg+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth ->+ (case ([]) of+ { _lhsOcrb ->+ (case (0) of+ { _lhsOrefOffsetMax ->+ (case (_lhsIstackDepth) of+ { _cmetasOstackDepth ->+ (case (_lhsIopts) of+ { _cmetasOopts ->+ (case (_lhsInm2ref) of+ { _cmetasOnm2ref ->+ (case (_lhsImodNr) of+ { _cmetasOmodNr ->+ (case (_lhsIlev) of+ { _cmetasOlev ->+ (case (_lhsIimpNmLkup) of+ { _cmetasOimpNmLkup ->+ (case (cmetas_1 _cmetasOimpNmLkup _cmetasOlev _cmetasOmodNr _cmetasOnm2ref _cmetasOopts _cmetasOstackDepth) of+ { ( _cmetasIstackDepth) ->+ (case (_cmetasIstackDepth) of+ { _lhsOstackDepth ->+ (case (0) of+ { _lhsOstackDepthMax ->+ ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CBound_Meta_1)) of+ { ( sem_CBound_1) ->+ ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBound_1) }) }) }) }) }))+sem_CBound_RelevTy :: ACoreBindAspectKeyS ->+ RelevTy ->+ T_CBound+sem_CBound_RelevTy aspectKeyS_ relevTy_ =+ (\ _lhsIevalCtx+ _lhsIisGlobal+ _lhsIlev+ _lhsInm+ _lhsIrefOffset ->+ (case (CR.emptyNm2RefMp) of+ { _lhsOnm2refGath ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CBound_RelevTy_1 :: T_CBound_1+ sem_CBound_RelevTy_1 =+ (\ _lhsIimpNmLkup+ _lhsIisTopApp+ _lhsIisTopTup+ _lhsIletBindingsCateg+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth ->+ (case ([]) of+ { _lhsOcrb ->+ (case (0) of+ { _lhsOrefOffsetMax ->+ (case (_lhsIstackDepth) of+ { _lhsOstackDepth ->+ (case (0) of+ { _lhsOstackDepthMax ->+ ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }))+ in sem_CBound_RelevTy_1)) of+ { ( sem_CBound_1) ->+ ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBound_1) }) }) }))+sem_CBound_Val :: ACoreBindAspectKeyS ->+ MetaLev ->+ CLbl ->+ T_CExpr ->+ T_CBound+sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ =+ (\ _lhsIevalCtx+ _lhsIisGlobal+ _lhsIlev+ _lhsInm+ _lhsIrefOffset ->+ (case (ExprIsBind _lhsInm) of+ { _whatAbove ->+ (case (_whatAbove) of+ { _exprOwhatAbove ->+ (case (expr_) of+ { ( _exprIwhatBelow,expr_1) ->+ (case (let mba@(~(Just (_,w))) = whatExprMbApp _exprIwhatBelow+ isVar = isJust $ whatExprMbVar _exprIwhatBelow+ isGlbVar = isVar && _lhsIisGlobal+ isApp = isJust mba+ isTup = isApp && whatExprIsTup w+ isWHNF = whatExprIsWHNF _exprIwhatBelow+ isNotWHNF = not isWHNF+ in case _lhsIevalCtx of+ EvalCtx_Eval+ | isApp -> ToBe_LeftAsIs+ | isVar -> ToBe_Forced+ | isNotWHNF -> ToBe_Forced+ EvalCtx_Thunk+ | isTup -> ToBe_LeftAsIs+ | isGlbVar -> ToBe_Thunked+ | isNotWHNF -> ToBe_Thunked+ _ -> ToBe_LeftAsIs) of+ { _toBe ->+ (case (_toBe == ToBe_Thunked) of+ { _isToBeThunked ->+ (case (if _isToBeThunked then _lhsIlev + 1 else _lhsIlev) of+ { _lev ->+ (case (_lev) of+ { _exprOlev ->+ (case (if _isToBeThunked then 0 else _lhsIrefOffset) of+ { _refOffsetExpr ->+ (case (_refOffsetExpr) of+ { _exprOrefOffset ->+ (case (expr_1 _exprOlev _exprOrefOffset _exprOwhatAbove) of+ { ( _exprInm2refGath,_exprIrefOffset,expr_2) ->+ (case (_exprInm2refGath) of+ { _lhsOnm2refGath ->+ (case (if _isToBeThunked then _lhsIrefOffset else _exprIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CBound_Val_1 :: T_CBound_1+ sem_CBound_Val_1 =+ (\ _lhsIimpNmLkup+ _lhsIisTopApp+ _lhsIisTopTup+ _lhsIletBindingsCateg+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth ->+ (case (if _isToBeThunked then TailCtx_TailCall else TailCtx_Plain) of+ { _tailCtx ->+ (case (_tailCtx) of+ { _exprOtailCtx ->+ (case (_lhsInm2ref) of+ { _exprOnm2ref ->+ (case (_lhsIimpNmLkup) of+ { _exprOimpNmLkup ->+ (case (if _isToBeThunked then _exprInm2refGath else CR.emptyNm2RefMp) of+ { _nm2refNew ->+ (case (_isToBeThunked || whatExprIsLam _exprIwhatBelow) of+ { _isToBeALam ->+ (case (if _isToBeALam then 0 else _lhsIstackDepth) of+ { _exprOstackDepth ->+ (case (_lhsIopts) of+ { _exprOopts ->+ (case (_lhsImodNr) of+ { _exprOmodNr ->+ (case (_lhsIisTopTup) of+ { _exprOisTopTup ->+ (case (_lhsIisTopApp) of+ { _exprOisTopApp ->+ (case (_lhsIevalCtx) of+ { _exprOevalCtx ->+ (case (expr_2 _exprOevalCtx _exprOimpNmLkup _exprOisTopApp _exprOisTopTup _exprOmodNr _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of+ { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax,_exprIvref) ->+ (case (max _exprIstackDepth _exprIstackDepthMax) of+ { _stackDepthMaxThunked ->+ (case (case _toBe of+ ToBe_Forced -> tailrec _tailCtx . CR.mkEval+ ToBe_Thunked -> CR.Exp_Lam (Just _lhsInm) 0 (_stackDepthMaxThunked) (CR.nm2RefMpInverse _nm2refNew)+ ToBe_LeftAsIs -> id) of+ { _creMkForce ->+ (case (_creMkForce _exprIcre) of+ { _creBind ->+ (case ([( _lhsInm, _creBind )]) of+ { _crb ->+ (case (_crb) of+ { _lhsOcrb ->+ (case (if _isToBeThunked then _lhsIrefOffset else max _exprIrefOffset _exprIrefOffsetMax) of+ { _lhsOrefOffsetMax ->+ (case (if _isToBeALam then _lhsIstackDepth+1 else _exprIstackDepth) of+ { _stackDepthExpr ->+ (case (_stackDepthExpr) of+ { _lhsOstackDepth ->+ (case (if _isToBeALam then _stackDepthExpr else _stackDepthMaxThunked) of+ { _lhsOstackDepthMax ->+ ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CBound_Val_1)) of+ { ( sem_CBound_1) ->+ ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBound_1) }) }) }) }) }) }) }) }) }) }) }) }) }))+sem_CBound_Ty :: ACoreBindAspectKeyS ->+ Ty ->+ T_CBound+sem_CBound_Ty aspectKeyS_ ty_ =+ (\ _lhsIevalCtx+ _lhsIisGlobal+ _lhsIlev+ _lhsInm+ _lhsIrefOffset ->+ (case (CR.emptyNm2RefMp) of+ { _lhsOnm2refGath ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CBound_Ty_1 :: T_CBound_1+ sem_CBound_Ty_1 =+ (\ _lhsIimpNmLkup+ _lhsIisTopApp+ _lhsIisTopTup+ _lhsIletBindingsCateg+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth ->+ (case ([]) of+ { _lhsOcrb ->+ (case (0) of+ { _lhsOrefOffsetMax ->+ (case (_lhsIstackDepth) of+ { _lhsOstackDepth ->+ (case (0) of+ { _lhsOstackDepthMax ->+ ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }))+ in sem_CBound_Ty_1)) of+ { ( sem_CBound_1) ->+ ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBound_1) }) }) }))+sem_CBound_FFE :: FFIWay ->+ ForeignEnt ->+ T_CExpr ->+ Ty ->+ T_CBound+sem_CBound_FFE callconv_ expEnt_ expr_ ty_ =+ (\ _lhsIevalCtx+ _lhsIisGlobal+ _lhsIlev+ _lhsInm+ _lhsIrefOffset ->+ (case (ExprIsLam 0 Nothing) of+ { _whatAbove ->+ (case (_whatAbove) of+ { _exprOwhatAbove ->+ (case (_lhsIrefOffset) of+ { _exprOrefOffset ->+ (case (_lhsIlev) of+ { _exprOlev ->+ (case (expr_) of+ { ( _exprIwhatBelow,expr_1) ->+ (case (expr_1 _exprOlev _exprOrefOffset _exprOwhatAbove) of+ { ( _exprInm2refGath,_exprIrefOffset,expr_2) ->+ (case (_exprInm2refGath) of+ { _lhsOnm2refGath ->+ (case (_exprIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CBound_FFE_1 :: T_CBound_1+ sem_CBound_FFE_1 =+ (\ _lhsIimpNmLkup+ _lhsIisTopApp+ _lhsIisTopTup+ _lhsIletBindingsCateg+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth ->+ (case (_lhsIstackDepth) of+ { _exprOstackDepth ->+ (case (_lhsInm2ref) of+ { _exprOnm2ref ->+ (case (_lhsIimpNmLkup) of+ { _exprOimpNmLkup ->+ (case (TailCtx_Plain) of+ { _tailCtx ->+ (case (_tailCtx) of+ { _exprOtailCtx ->+ (case (_lhsIopts) of+ { _exprOopts ->+ (case (_lhsImodNr) of+ { _exprOmodNr ->+ (case (_lhsIevalCtx) of+ { _exprOevalCtx ->+ (case (True) of+ { _exprOisTopTup ->+ (case (True) of+ { _exprOisTopApp ->+ (case (expr_2 _exprOevalCtx _exprOimpNmLkup _exprOisTopApp _exprOisTopTup _exprOmodNr _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of+ { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax,_exprIvref) ->+ (case (_exprIcrb) of+ { _lhsOcrb ->+ (case (_exprIrefOffsetMax) of+ { _lhsOrefOffsetMax ->+ (case (_exprIstackDepth) of+ { _lhsOstackDepth ->+ (case (_exprIstackDepthMax) of+ { _lhsOstackDepthMax ->+ ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CBound_FFE_1)) of+ { ( sem_CBound_1) ->+ ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBound_1) }) }) }) }) }) }) }) }) }))+-- CBoundL -----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ evalCtx : EvalCtx+ impNmLkup : HsName -> Maybe Int+ isGlobal : Bool+ letBindingsCateg : CBindCateg+ lev : Int+ modNr : Int+ nm : HsName+ nm2ref : CR.Nm2RefMp+ opts : EHCOpts+ chained attributes:+ refOffset : Int+ stackDepth : Int+ synthesized attributes:+ crb : [(HsName, CR.Bind)]+ nm2refGath : CR.Nm2RefMp+ refOffsetMax : Int+ stackDepthMax : Int+ alternatives:+ alternative Cons:+ child hd : CBound + child tl : CBoundL + alternative Nil:+-}+-- cata+sem_CBoundL :: CBoundL ->+ T_CBoundL+sem_CBoundL list =+ (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list))+-- semantic domain+type T_CBoundL = EvalCtx ->+ (HsName -> Maybe Int) ->+ Bool ->+ CBindCateg ->+ Int ->+ Int ->+ HsName ->+ (CR.Nm2RefMp) ->+ EHCOpts ->+ Int ->+ Int ->+ ( ([(HsName, CR.Bind)]),(CR.Nm2RefMp),Int,Int,Int,Int)+sem_CBoundL_Cons :: T_CBound ->+ T_CBoundL ->+ T_CBoundL+sem_CBoundL_Cons hd_ tl_ =+ (\ _lhsIevalCtx+ _lhsIimpNmLkup+ _lhsIisGlobal+ _lhsIletBindingsCateg+ _lhsIlev+ _lhsImodNr+ _lhsInm+ _lhsInm2ref+ _lhsIopts+ _lhsIrefOffset+ _lhsIstackDepth ->+ (case (_lhsIstackDepth) of+ { _hdOstackDepth ->+ (case (_lhsIrefOffset) of+ { _hdOrefOffset ->+ (case (_lhsInm) of+ { _hdOnm ->+ (case (_lhsIlev) of+ { _hdOlev ->+ (case (_lhsIisGlobal) of+ { _hdOisGlobal ->+ (case (_lhsIevalCtx) of+ { _hdOevalCtx ->+ (case (hd_ _hdOevalCtx _hdOisGlobal _hdOlev _hdOnm _hdOrefOffset) of+ { ( _hdInm2refGath,_hdIrefOffset,hd_1) ->+ (case (_lhsIopts) of+ { _hdOopts ->+ (case (_lhsInm2ref) of+ { _hdOnm2ref ->+ (case (_lhsImodNr) of+ { _hdOmodNr ->+ (case (_lhsIletBindingsCateg) of+ { _hdOletBindingsCateg ->+ (case (_lhsIimpNmLkup) of+ { _hdOimpNmLkup ->+ (case (True) of+ { _hdOisTopTup ->+ (case (True) of+ { _hdOisTopApp ->+ (case (hd_1 _hdOimpNmLkup _hdOisTopApp _hdOisTopTup _hdOletBindingsCateg _hdOmodNr _hdOnm2ref _hdOopts _hdOstackDepth) of+ { ( _hdIcrb,_hdIrefOffsetMax,_hdIstackDepth,_hdIstackDepthMax) ->+ (case (_hdIstackDepth) of+ { _tlOstackDepth ->+ (case (_hdIrefOffset) of+ { _tlOrefOffset ->+ (case (_lhsInm2ref) of+ { _tlOnm2ref ->+ (case (_lhsInm) of+ { _tlOnm ->+ (case (_lhsIlev) of+ { _tlOlev ->+ (case (_lhsIisGlobal) of+ { _tlOisGlobal ->+ (case (_lhsIimpNmLkup) of+ { _tlOimpNmLkup ->+ (case (_lhsIevalCtx) of+ { _tlOevalCtx ->+ (case (_lhsIopts) of+ { _tlOopts ->+ (case (_lhsImodNr) of+ { _tlOmodNr ->+ (case (_lhsIletBindingsCateg) of+ { _tlOletBindingsCateg ->+ (case (tl_ _tlOevalCtx _tlOimpNmLkup _tlOisGlobal _tlOletBindingsCateg _tlOlev _tlOmodNr _tlOnm _tlOnm2ref _tlOopts _tlOrefOffset _tlOstackDepth) of+ { ( _tlIcrb,_tlInm2refGath,_tlIrefOffset,_tlIrefOffsetMax,_tlIstackDepth,_tlIstackDepthMax) ->+ (case (_hdIcrb ++ _tlIcrb) of+ { _lhsOcrb ->+ (case (_hdInm2refGath `CR.nm2refUnion` _tlInm2refGath) of+ { _lhsOnm2refGath ->+ (case (_tlIrefOffset) of+ { _lhsOrefOffset ->+ (case (_hdIrefOffsetMax `max` _tlIrefOffsetMax) of+ { _lhsOrefOffsetMax ->+ (case (_tlIstackDepth) of+ { _lhsOstackDepth ->+ (case (_hdIstackDepthMax `max` _tlIstackDepthMax) of+ { _lhsOstackDepthMax ->+ ( _lhsOcrb,_lhsOnm2refGath,_lhsOrefOffset,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+sem_CBoundL_Nil :: T_CBoundL+sem_CBoundL_Nil =+ (\ _lhsIevalCtx+ _lhsIimpNmLkup+ _lhsIisGlobal+ _lhsIletBindingsCateg+ _lhsIlev+ _lhsImodNr+ _lhsInm+ _lhsInm2ref+ _lhsIopts+ _lhsIrefOffset+ _lhsIstackDepth ->+ (case ([]) of+ { _lhsOcrb ->+ (case (CR.emptyNm2RefMp) of+ { _lhsOnm2refGath ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case (0) of+ { _lhsOrefOffsetMax ->+ (case (_lhsIstackDepth) of+ { _lhsOstackDepth ->+ (case (0) of+ { _lhsOstackDepthMax ->+ ( _lhsOcrb,_lhsOnm2refGath,_lhsOrefOffset,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }))+-- CDataCon ----------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ crdc : [CR.DataCon]+ alternatives:+ alternative Con:+ child conNm : {HsName}+ child tagNr : {Int}+ child arity : {Int}+-}+-- cata+sem_CDataCon :: CDataCon ->+ T_CDataCon+sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) =+ (sem_CDataCon_Con _conNm _tagNr _arity)+-- semantic domain+type T_CDataCon = ( ([CR.DataCon]))+sem_CDataCon_Con :: HsName ->+ Int ->+ Int ->+ T_CDataCon+sem_CDataCon_Con conNm_ tagNr_ arity_ =+ (case ([CR.DataCon_Con (hsnQualified conNm_) tagNr_]) of+ { _lhsOcrdc ->+ ( _lhsOcrdc) })+-- CDataConL ---------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ crdc : [CR.DataCon]+ alternatives:+ alternative Cons:+ child hd : CDataCon + child tl : CDataConL + alternative Nil:+-}+-- cata+sem_CDataConL :: CDataConL ->+ T_CDataConL+sem_CDataConL list =+ (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list))+-- semantic domain+type T_CDataConL = ( ([CR.DataCon]))+sem_CDataConL_Cons :: T_CDataCon ->+ T_CDataConL ->+ T_CDataConL+sem_CDataConL_Cons hd_ tl_ =+ (case (tl_) of+ { ( _tlIcrdc) ->+ (case (hd_) of+ { ( _hdIcrdc) ->+ (case (_hdIcrdc ++ _tlIcrdc) of+ { _lhsOcrdc ->+ ( _lhsOcrdc) }) }) })+sem_CDataConL_Nil :: T_CDataConL+sem_CDataConL_Nil =+ (case ([]) of+ { _lhsOcrdc ->+ ( _lhsOcrdc) })+-- CDeclMeta ---------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ crmt : [CR.Meta]+ alternatives:+ alternative Data:+ child tyNm : {HsName}+ child dataCons : CDataConL +-}+-- cata+sem_CDeclMeta :: CDeclMeta ->+ T_CDeclMeta+sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) =+ (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons))+-- semantic domain+type T_CDeclMeta = ( ([CR.Meta]))+sem_CDeclMeta_Data :: HsName ->+ T_CDataConL ->+ T_CDeclMeta+sem_CDeclMeta_Data tyNm_ dataCons_ =+ (case (dataCons_) of+ { ( _dataConsIcrdc) ->+ (case ([CR.Meta_Data tyNm_ _dataConsIcrdc]) of+ { _lhsOcrmt ->+ ( _lhsOcrmt) }) })+-- CDeclMetaL --------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ crmt : [CR.Meta]+ alternatives:+ alternative Cons:+ child hd : CDeclMeta + child tl : CDeclMetaL + alternative Nil:+-}+-- cata+sem_CDeclMetaL :: CDeclMetaL ->+ T_CDeclMetaL+sem_CDeclMetaL list =+ (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list))+-- semantic domain+type T_CDeclMetaL = ( ([CR.Meta]))+sem_CDeclMetaL_Cons :: T_CDeclMeta ->+ T_CDeclMetaL ->+ T_CDeclMetaL+sem_CDeclMetaL_Cons hd_ tl_ =+ (case (tl_) of+ { ( _tlIcrmt) ->+ (case (hd_) of+ { ( _hdIcrmt) ->+ (case (_hdIcrmt ++ _tlIcrmt) of+ { _lhsOcrmt ->+ ( _lhsOcrmt) }) }) })+sem_CDeclMetaL_Nil :: T_CDeclMetaL+sem_CDeclMetaL_Nil =+ (case ([]) of+ { _lhsOcrmt ->+ ( _lhsOcrmt) })+-- CExport -----------------------------------------------------+{-+ alternatives:+ alternative Export:+ child nm : {HsName}+ alternative ExportData:+ child nm : {HsName}+ child mbConNmL : {Maybe [HsName]}+-}+-- cata+sem_CExport :: CExport ->+ T_CExport+sem_CExport (CExport_Export _nm) =+ (sem_CExport_Export _nm)+sem_CExport (CExport_ExportData _nm _mbConNmL) =+ (sem_CExport_ExportData _nm _mbConNmL)+-- semantic domain+type T_CExport = ( )+sem_CExport_Export :: HsName ->+ T_CExport+sem_CExport_Export nm_ =+ ( )+sem_CExport_ExportData :: HsName ->+ (Maybe [HsName]) ->+ T_CExport+sem_CExport_ExportData nm_ mbConNmL_ =+ ( )+-- CExportL ----------------------------------------------------+{-+ alternatives:+ alternative Cons:+ child hd : CExport + child tl : CExportL + alternative Nil:+-}+-- cata+sem_CExportL :: CExportL ->+ T_CExportL+sem_CExportL list =+ (Prelude.foldr sem_CExportL_Cons sem_CExportL_Nil (Prelude.map sem_CExport list))+-- semantic domain+type T_CExportL = ( )+sem_CExportL_Cons :: T_CExport ->+ T_CExportL ->+ T_CExportL+sem_CExportL_Cons hd_ tl_ =+ ( )+sem_CExportL_Nil :: T_CExportL+sem_CExportL_Nil =+ ( )+-- CExpr -------------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ whatBelow : WhatExpr+ visit 1:+ inherited attributes:+ lev : Int+ whatAbove : WhatExpr+ chained attribute:+ refOffset : Int+ synthesized attribute:+ nm2refGath : CR.Nm2RefMp+ visit 2:+ inherited attributes:+ evalCtx : EvalCtx+ impNmLkup : HsName -> Maybe Int+ isTopApp : Bool+ isTopTup : Bool+ modNr : Int+ nm2ref : CR.Nm2RefMp+ opts : EHCOpts+ tailCtx : TailCtx+ chained attribute:+ stackDepth : Int+ synthesized attributes:+ appFunKind : AppFunKind+ crb : [(HsName, CR.Bind)]+ cre : CR.Exp+ creAppArgL : [CR.SExp]+ creAppFun : TailCtx -> CR.CRArray CR.SExp -> CR.Exp+ creLamArgL : [HsName]+ creLamBody : CR.Exp+ crse : CR.SExp+ mbFFIApp : Maybe ( Ty+ , Bool+ , FFIWay+ , ForeignEnt+ , [Ty]+ )+ mbLam : Maybe [HsName]+ mbVar : Maybe HsName+ refOffsetMax : Int+ stackDepthMax : Int+ vref : CR.RRef+ alternatives:+ alternative Var:+ child ref : {ACoreBindRef}+ visit 0:+ local nm : {HsName}+ local whatBelow : _+ visit 1:+ intra nm : {HsName}+ visit 2:+ local vref : _+ local crse : _+ local creBase : _+ local cre : _+ local creAppArgL : _+ local creAppFun : _+ local creLamArgL : _+ local creLamBody : _+ local mbVar : {Maybe HsName}+ local stackDepthHere : _+ intra nm : {HsName}+ alternative Int:+ child int : {Int}+ visit 0:+ local whatBelow : _+ visit 2:+ local crse : _+ local creBase : _+ local cre : _+ local creAppArgL : _+ local creAppFun : _+ local creLamArgL : _+ local creLamBody : _+ local stackDepthHere : _+ local vref : _+ alternative Char:+ child char : {Char}+ visit 0:+ local whatBelow : _+ visit 2:+ local crse : _+ local creBase : _+ local cre : _+ local creAppArgL : _+ local creAppFun : _+ local creLamArgL : _+ local creLamBody : _+ local stackDepthHere : _+ local vref : _+ alternative String:+ child str : {String}+ visit 0:+ local whatBelow : _+ visit 2:+ local crse : _+ local creBase : _+ local cre : _+ local creAppArgL : _+ local creAppFun : _+ local creLamArgL : _+ local creLamBody : _+ local stackDepthHere : _+ local vref : _+ alternative Integer:+ child integer : {Integer}+ visit 0:+ local whatBelow : _+ visit 2:+ local crse : _+ local creBase : _+ local cre : _+ local creAppArgL : _+ local creAppFun : _+ local creLamArgL : _+ local creLamBody : _+ local stackDepthHere : _+ local vref : _+ alternative Tup:+ child tag : {CTag}+ visit 0:+ local whatBelow : _+ visit 2:+ local creBase : _+ local cre : _+ local creAppArgL : _+ local creAppFun : _+ local creLamArgL : _+ local creLamBody : _+ local crse : _+ local stackDepthHere : _+ local vref : _+ alternative Let:+ child categ : {CBindCateg}+ child binds : CBindL + child body : CExpr + visit 0:+ local whatBelow : _+ visit 1:+ local whatAbove : {WhatExpr}+ local isGlobal : _+ local _tup1 : _+ visit 2:+ local evalCtx : _+ local letBindingsCateg : _+ local _tup2 : _+ local isTopTup : _+ local isTopApp : {Bool}+ local nm2refNew : _+ local creBase : _+ local cre : _+ local creAppArgL : _+ local creAppFun : _+ local creLamArgL : _+ local creLamBody : _+ local crse : _+ local refOffsetMax : _+ local stackDepthMax : _+ local vref : _+ intra isGlobal : _+ intra _tup1 : _+ alternative App:+ child func : CExpr + child arg : CBound + visit 0:+ local whatBelow : _+ visit 1:+ local whatAbove : {WhatExpr}+ local isGlobal : _+ visit 2:+ local tailCtx : _+ local isTopTup : _+ local creAppFun : _+ local stackDepthFunc : _+ local letBindingsCateg : _+ local creAppArgL : _+ local isTopApp' : _+ local creBase : _+ local cre : _+ local creLamArgL : _+ local creLamBody : _+ local crse : _+ local stackDepthMax : _+ local vref : _+ alternative Lam:+ child bind : CBind + child body : CExpr + visit 0:+ local whatBelow : _+ visit 1:+ local whatAbove : {WhatExpr}+ local isTopLam : _+ local lev : _+ local _tup3 : _+ local refOffsetBody : _+ local refOffset : _+ local isGlobal : _+ local nm2refNew : _+ visit 2:+ local nm2ref : _+ local isTopTup : _+ local isTopApp : {Bool}+ local creLamArgL : _+ local stackDepthMax : _+ local creBase : _+ local cre : _+ local creAppArgL : _+ local creAppFun : _+ local creLamBody : _+ local crse : _+ local argNm : _+ local refOffsetMax : _+ local vref : _+ intra nm2refNew : _+ intra isTopLam : _+ intra refOffsetBody : _+ alternative Case:+ child expr : CExpr + child alts : CAltL + child dflt : CExpr + visit 0:+ local whatBelow : _+ visit 1:+ local whatAbove : {WhatExpr}+ visit 2:+ local isTopTup : _+ local isTopApp : {Bool}+ local creBase : _+ local cre : _+ local creAppArgL : _+ local creAppFun : _+ local creLamArgL : _+ local creLamBody : _+ local crse : _+ local stackDepthHere : _+ local stackDepthMax : _+ local vref : _+ alternative CaseAltFail:+ child failReason : {CaseAltFailReason}+ child errorExpr : CExpr + visit 1:+ local whatAbove : {WhatExpr}+ visit 2:+ local isTopTup : _+ local isTopApp : {Bool}+ local creBase : _+ local cre : _+ local creAppArgL : _+ local creAppFun : _+ local creLamArgL : _+ local creLamBody : _+ local crse : _+ local stackDepthHere : _+ local vref : _+ alternative TupDel:+ child expr : CExpr + child tag : {CTag}+ child nm : {HsName}+ child offset : CExpr + visit 0:+ local whatBelow : _+ visit 1:+ local whatAbove : {WhatExpr}+ visit 2:+ local creBase : _+ local cre : _+ local creAppArgL : _+ local creAppFun : _+ local creLamArgL : _+ local creLamBody : _+ local crse : _+ local isTopApp : {Bool}+ local isTopTup : _+ local stackDepthHere : _+ local vref : _+ alternative TupIns:+ child expr : CExpr + child tag : {CTag}+ child nm : {HsName}+ child offset : CExpr + child fldExpr : CExpr + visit 0:+ local whatBelow : _+ visit 1:+ local whatAbove : {WhatExpr}+ visit 2:+ local creBase : _+ local cre : _+ local creAppArgL : _+ local creAppFun : _+ local creLamArgL : _+ local creLamBody : _+ local crse : _+ local isTopApp : {Bool}+ local isTopTup : _+ local stackDepthHere : _+ local vref : _+ alternative TupUpd:+ child expr : CExpr + child tag : {CTag}+ child nm : {HsName}+ child offset : CExpr + child fldExpr : CExpr + visit 0:+ local whatBelow : _+ visit 1:+ local whatAbove : {WhatExpr}+ visit 2:+ local creBase : _+ local cre : _+ local creAppArgL : _+ local creAppFun : _+ local creLamArgL : _+ local creLamBody : _+ local crse : _+ local isTopApp : {Bool}+ local isTopTup : _+ local stackDepthHere : _+ local vref : _+ alternative FFI:+ child callconv : {FFIWay}+ child safety : {String}+ child impEnt : {ForeignEnt}+ child ty : {Ty}+ visit 0:+ local whatBelow : _+ visit 2:+ local foreignEntInfo : _+ local creEntMb : _+ local creMk : _+ local creBase : _+ local cre : _+ local creAppArgL : _+ local creAppFun : _+ local creLamArgL : _+ local creLamBody : _+ local crse : _+ local mbPrimNeedEval : {Maybe PrimitiveNeedsEval}+ local primResNeedsEval : {Bool}+ local argTyLresTy : {( TyL, Ty )}+ local resTy : _+ local argTyL : {TyL}+ local stackDepthHere : _+ local vref : _+ alternative Dbg:+ child info : {String}+ visit 0:+ local whatBelow : _+ visit 2:+ local creBase : _+ local cre : _+ local creAppArgL : _+ local creAppFun : _+ local creLamArgL : _+ local creLamBody : _+ local crse : _+ local stackDepthHere : _+ local vref : _+ alternative Hole:+ child uid : {UID}+ visit 0:+ local whatBelow : _+ visit 2:+ local creBase : _+ local cre : _+ local creAppArgL : _+ local creAppFun : _+ local creLamArgL : _+ local creLamBody : _+ local crse : _+ local stackDepthHere : _+ local vref : _+ alternative HoleLet:+ child bindsUid : {UID}+ child body : CExpr + visit 0:+ local whatBelow : _+ visit 1:+ local whatAbove : {WhatExpr}+ visit 2:+ local creBase : _+ local cre : _+ local creAppArgL : _+ local creAppFun : _+ local creLamArgL : _+ local creLamBody : _+ local crse : _+ local isTopTup : _+ local isTopApp : {Bool}+ local stackDepthHere : _+ local vref : _+ alternative CoeArg:+ visit 0:+ local whatBelow : _+ visit 2:+ local creBase : _+ local cre : _+ local creAppArgL : _+ local creAppFun : _+ local creLamArgL : _+ local creLamBody : _+ local crse : _+ local stackDepthHere : _+ local vref : _+ alternative ImplsApp:+ child func : CExpr + child uid : {ImplsVarId}+ visit 0:+ local whatBelow : _+ visit 1:+ local whatAbove : {WhatExpr}+ visit 2:+ local creBase : _+ local cre : _+ local creAppArgL : _+ local creAppFun : _+ local creLamArgL : _+ local creLamBody : _+ local crse : _+ local isTopTup : _+ local isTopApp : {Bool}+ local stackDepthHere : _+ local vref : _+ alternative ImplsLam:+ child uid : {ImplsVarId}+ child body : CExpr + visit 0:+ local whatBelow : _+ visit 1:+ local whatAbove : {WhatExpr}+ visit 2:+ local creBase : _+ local cre : _+ local creAppArgL : _+ local creAppFun : _+ local creLamArgL : _+ local creLamBody : _+ local crse : _+ local isTopTup : _+ local isTopApp : {Bool}+ local stackDepthHere : _+ local vref : _+ alternative Ann:+ child ann : CExprAnn + child expr : CExpr + visit 2:+ local crse : _+ local vref : _+-}+-- cata+sem_CExpr :: CExpr ->+ T_CExpr+sem_CExpr (CExpr_Var _ref) =+ (sem_CExpr_Var _ref)+sem_CExpr (CExpr_Int _int) =+ (sem_CExpr_Int _int)+sem_CExpr (CExpr_Char _char) =+ (sem_CExpr_Char _char)+sem_CExpr (CExpr_String _str) =+ (sem_CExpr_String _str)+sem_CExpr (CExpr_Integer _integer) =+ (sem_CExpr_Integer _integer)+sem_CExpr (CExpr_Tup _tag) =+ (sem_CExpr_Tup _tag)+sem_CExpr (CExpr_Let _categ _binds _body) =+ (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body))+sem_CExpr (CExpr_App _func _arg) =+ (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg))+sem_CExpr (CExpr_Lam _bind _body) =+ (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body))+sem_CExpr (CExpr_Case _expr _alts _dflt) =+ (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt))+sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) =+ (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr))+sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) =+ (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset))+sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) =+ (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr))+sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) =+ (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr))+sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) =+ (sem_CExpr_FFI _callconv _safety _impEnt _ty)+sem_CExpr (CExpr_Dbg _info) =+ (sem_CExpr_Dbg _info)+sem_CExpr (CExpr_Hole _uid) =+ (sem_CExpr_Hole _uid)+sem_CExpr (CExpr_HoleLet _bindsUid _body) =+ (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body))+sem_CExpr (CExpr_CoeArg) =+ (sem_CExpr_CoeArg)+sem_CExpr (CExpr_ImplsApp _func _uid) =+ (sem_CExpr_ImplsApp (sem_CExpr _func) _uid)+sem_CExpr (CExpr_ImplsLam _uid _body) =+ (sem_CExpr_ImplsLam _uid (sem_CExpr _body))+sem_CExpr (CExpr_Ann _ann _expr) =+ (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr))+-- semantic domain+type T_CExpr = ( WhatExpr,T_CExpr_1)+type T_CExpr_1 = Int ->+ Int ->+ WhatExpr ->+ ( (CR.Nm2RefMp),Int,T_CExpr_2)+type T_CExpr_2 = EvalCtx ->+ (HsName -> Maybe Int) ->+ Bool ->+ Bool ->+ Int ->+ (CR.Nm2RefMp) ->+ EHCOpts ->+ Int ->+ TailCtx ->+ ( AppFunKind,([(HsName, CR.Bind)]),(CR.Exp),([CR.SExp]),(TailCtx -> CR.CRArray CR.SExp -> CR.Exp),([HsName]),(CR.Exp),(CR.SExp),(Maybe ( Ty+ , Bool+ , FFIWay+ , ForeignEnt+ , [Ty]+ )),(Maybe [HsName]),(Maybe HsName),Int,Int,Int,(CR.RRef))+sem_CExpr_Var :: ACoreBindRef ->+ T_CExpr+sem_CExpr_Var ref_ =+ (case (acbrefNm ref_) of+ { _nm ->+ (case (ExprIsVar _nm) of+ { _whatBelow ->+ (case (_whatBelow) of+ { _lhsOwhatBelow ->+ (case ((let sem_CExpr_Var_1 :: T_CExpr_1+ sem_CExpr_Var_1 =+ (\ _lhsIlev+ _lhsIrefOffset+ _lhsIwhatAbove ->+ (case (CR.emptyNm2RefMp) of+ { _lhsOnm2refGath ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CExpr_Var_2 :: T_CExpr_2+ sem_CExpr_Var_2 =+ (\ _lhsIevalCtx+ _lhsIimpNmLkup+ _lhsIisTopApp+ _lhsIisTopTup+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth+ _lhsItailCtx ->+ (case (AppFunKind_Fun ref_) of+ { _lhsOappFunKind ->+ (case ([]) of+ { _lhsOcrb ->+ (case (maybe (CR.RRef_Dbg _nm) (CR.rrefToImp _lhsIimpNmLkup . CR.rrefToDif _lhsIlev) $ CR.nm2refLookup _nm _lhsInm2ref) of+ { _vref ->+ (case (CR.mkVar' _vref) of+ { _crse ->+ (case (taileval _lhsItailCtx $ CR.mkExp _crse) of+ { _creBase ->+ (case (cseCtxWrap _lhsItailCtx _creBase) of+ { _cre ->+ (case (_cre) of+ { _lhsOcre ->+ (case ([]) of+ { _creAppArgL ->+ (case (_creAppArgL) of+ { _lhsOcreAppArgL ->+ (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of+ { _creAppFun ->+ (case (_creAppFun) of+ { _lhsOcreAppFun ->+ (case ([]) of+ { _creLamArgL ->+ (case (_creLamArgL) of+ { _lhsOcreLamArgL ->+ (case (_cre) of+ { _creLamBody ->+ (case (_creLamBody) of+ { _lhsOcreLamBody ->+ (case (_crse) of+ { _lhsOcrse ->+ (case (Nothing) of+ { _lhsOmbFFIApp ->+ (case (Nothing) of+ { _lhsOmbLam ->+ (case (Just _nm) of+ { _mbVar ->+ (case (_mbVar) of+ { _lhsOmbVar ->+ (case (0) of+ { _lhsOrefOffsetMax ->+ (case (_lhsIstackDepth + 1) of+ { _stackDepthHere ->+ (case (_stackDepthHere) of+ { _lhsOstackDepth ->+ (case (_stackDepthHere) of+ { _lhsOstackDepthMax ->+ (case (_vref) of+ { _lhsOvref ->+ ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_Var_2)) of+ { ( sem_CExpr_2) ->+ ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }))+ in sem_CExpr_Var_1)) of+ { ( sem_CExpr_1) ->+ ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) })+sem_CExpr_Int :: Int ->+ T_CExpr+sem_CExpr_Int int_ =+ (case (ExprIsInt int_) of+ { _whatBelow ->+ (case (_whatBelow) of+ { _lhsOwhatBelow ->+ (case ((let sem_CExpr_Int_1 :: T_CExpr_1+ sem_CExpr_Int_1 =+ (\ _lhsIlev+ _lhsIrefOffset+ _lhsIwhatAbove ->+ (case (CR.emptyNm2RefMp) of+ { _lhsOnm2refGath ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CExpr_Int_2 :: T_CExpr_2+ sem_CExpr_Int_2 =+ (\ _lhsIevalCtx+ _lhsIimpNmLkup+ _lhsIisTopApp+ _lhsIisTopTup+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth+ _lhsItailCtx ->+ (case (AppFunKind_NoApp) of+ { _lhsOappFunKind ->+ (case ([]) of+ { _lhsOcrb ->+ (case (CR.mkInt' int_) of+ { _crse ->+ (case (CR.mkExp _crse) of+ { _creBase ->+ (case (cseCtxWrap _lhsItailCtx _creBase) of+ { _cre ->+ (case (_cre) of+ { _lhsOcre ->+ (case ([]) of+ { _creAppArgL ->+ (case (_creAppArgL) of+ { _lhsOcreAppArgL ->+ (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of+ { _creAppFun ->+ (case (_creAppFun) of+ { _lhsOcreAppFun ->+ (case ([]) of+ { _creLamArgL ->+ (case (_creLamArgL) of+ { _lhsOcreLamArgL ->+ (case (_cre) of+ { _creLamBody ->+ (case (_creLamBody) of+ { _lhsOcreLamBody ->+ (case (_crse) of+ { _lhsOcrse ->+ (case (Nothing) of+ { _lhsOmbFFIApp ->+ (case (Nothing) of+ { _lhsOmbLam ->+ (case (Nothing) of+ { _lhsOmbVar ->+ (case (0) of+ { _lhsOrefOffsetMax ->+ (case (_lhsIstackDepth + 1) of+ { _stackDepthHere ->+ (case (_stackDepthHere) of+ { _lhsOstackDepth ->+ (case (_stackDepthHere) of+ { _lhsOstackDepthMax ->+ (case (panic "Core.ToCoreRun.CExpr.ref") of+ { _vref ->+ (case (_vref) of+ { _lhsOvref ->+ ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_Int_2)) of+ { ( sem_CExpr_2) ->+ ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }))+ in sem_CExpr_Int_1)) of+ { ( sem_CExpr_1) ->+ ( _lhsOwhatBelow,sem_CExpr_1) }) }) })+sem_CExpr_Char :: Char ->+ T_CExpr+sem_CExpr_Char char_ =+ (case (ExprIsOtherWHNF) of+ { _whatBelow ->+ (case (_whatBelow) of+ { _lhsOwhatBelow ->+ (case ((let sem_CExpr_Char_1 :: T_CExpr_1+ sem_CExpr_Char_1 =+ (\ _lhsIlev+ _lhsIrefOffset+ _lhsIwhatAbove ->+ (case (CR.emptyNm2RefMp) of+ { _lhsOnm2refGath ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CExpr_Char_2 :: T_CExpr_2+ sem_CExpr_Char_2 =+ (\ _lhsIevalCtx+ _lhsIimpNmLkup+ _lhsIisTopApp+ _lhsIisTopTup+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth+ _lhsItailCtx ->+ (case (AppFunKind_NoApp) of+ { _lhsOappFunKind ->+ (case ([]) of+ { _lhsOcrb ->+ (case (CR.mkChar' char_) of+ { _crse ->+ (case (CR.mkExp _crse) of+ { _creBase ->+ (case (cseCtxWrap _lhsItailCtx _creBase) of+ { _cre ->+ (case (_cre) of+ { _lhsOcre ->+ (case ([]) of+ { _creAppArgL ->+ (case (_creAppArgL) of+ { _lhsOcreAppArgL ->+ (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of+ { _creAppFun ->+ (case (_creAppFun) of+ { _lhsOcreAppFun ->+ (case ([]) of+ { _creLamArgL ->+ (case (_creLamArgL) of+ { _lhsOcreLamArgL ->+ (case (_cre) of+ { _creLamBody ->+ (case (_creLamBody) of+ { _lhsOcreLamBody ->+ (case (_crse) of+ { _lhsOcrse ->+ (case (Nothing) of+ { _lhsOmbFFIApp ->+ (case (Nothing) of+ { _lhsOmbLam ->+ (case (Nothing) of+ { _lhsOmbVar ->+ (case (0) of+ { _lhsOrefOffsetMax ->+ (case (_lhsIstackDepth + 1) of+ { _stackDepthHere ->+ (case (_stackDepthHere) of+ { _lhsOstackDepth ->+ (case (_stackDepthHere) of+ { _lhsOstackDepthMax ->+ (case (panic "Core.ToCoreRun.CExpr.ref") of+ { _vref ->+ (case (_vref) of+ { _lhsOvref ->+ ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_Char_2)) of+ { ( sem_CExpr_2) ->+ ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }))+ in sem_CExpr_Char_1)) of+ { ( sem_CExpr_1) ->+ ( _lhsOwhatBelow,sem_CExpr_1) }) }) })+sem_CExpr_String :: String ->+ T_CExpr+sem_CExpr_String str_ =+ (case (ExprIsOtherWHNF) of+ { _whatBelow ->+ (case (_whatBelow) of+ { _lhsOwhatBelow ->+ (case ((let sem_CExpr_String_1 :: T_CExpr_1+ sem_CExpr_String_1 =+ (\ _lhsIlev+ _lhsIrefOffset+ _lhsIwhatAbove ->+ (case (CR.emptyNm2RefMp) of+ { _lhsOnm2refGath ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CExpr_String_2 :: T_CExpr_2+ sem_CExpr_String_2 =+ (\ _lhsIevalCtx+ _lhsIimpNmLkup+ _lhsIisTopApp+ _lhsIisTopTup+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth+ _lhsItailCtx ->+ (case (AppFunKind_NoApp) of+ { _lhsOappFunKind ->+ (case ([]) of+ { _lhsOcrb ->+ (case (CR.mkString' str_) of+ { _crse ->+ (case (CR.mkExp _crse) of+ { _creBase ->+ (case (cseCtxWrap _lhsItailCtx _creBase) of+ { _cre ->+ (case (_cre) of+ { _lhsOcre ->+ (case ([]) of+ { _creAppArgL ->+ (case (_creAppArgL) of+ { _lhsOcreAppArgL ->+ (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of+ { _creAppFun ->+ (case (_creAppFun) of+ { _lhsOcreAppFun ->+ (case ([]) of+ { _creLamArgL ->+ (case (_creLamArgL) of+ { _lhsOcreLamArgL ->+ (case (_cre) of+ { _creLamBody ->+ (case (_creLamBody) of+ { _lhsOcreLamBody ->+ (case (_crse) of+ { _lhsOcrse ->+ (case (Nothing) of+ { _lhsOmbFFIApp ->+ (case (Nothing) of+ { _lhsOmbLam ->+ (case (Nothing) of+ { _lhsOmbVar ->+ (case (0) of+ { _lhsOrefOffsetMax ->+ (case (_lhsIstackDepth + 1) of+ { _stackDepthHere ->+ (case (_stackDepthHere) of+ { _lhsOstackDepth ->+ (case (_stackDepthHere) of+ { _lhsOstackDepthMax ->+ (case (panic "Core.ToCoreRun.CExpr.ref") of+ { _vref ->+ (case (_vref) of+ { _lhsOvref ->+ ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_String_2)) of+ { ( sem_CExpr_2) ->+ ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }))+ in sem_CExpr_String_1)) of+ { ( sem_CExpr_1) ->+ ( _lhsOwhatBelow,sem_CExpr_1) }) }) })+sem_CExpr_Integer :: Integer ->+ T_CExpr+sem_CExpr_Integer integer_ =+ (case (ExprIsOtherWHNF) of+ { _whatBelow ->+ (case (_whatBelow) of+ { _lhsOwhatBelow ->+ (case ((let sem_CExpr_Integer_1 :: T_CExpr_1+ sem_CExpr_Integer_1 =+ (\ _lhsIlev+ _lhsIrefOffset+ _lhsIwhatAbove ->+ (case (CR.emptyNm2RefMp) of+ { _lhsOnm2refGath ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CExpr_Integer_2 :: T_CExpr_2+ sem_CExpr_Integer_2 =+ (\ _lhsIevalCtx+ _lhsIimpNmLkup+ _lhsIisTopApp+ _lhsIisTopTup+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth+ _lhsItailCtx ->+ (case (AppFunKind_NoApp) of+ { _lhsOappFunKind ->+ (case ([]) of+ { _lhsOcrb ->+ (case (CR.SExp_Integer integer_) of+ { _crse ->+ (case (CR.mkExp _crse) of+ { _creBase ->+ (case (cseCtxWrap _lhsItailCtx _creBase) of+ { _cre ->+ (case (_cre) of+ { _lhsOcre ->+ (case ([]) of+ { _creAppArgL ->+ (case (_creAppArgL) of+ { _lhsOcreAppArgL ->+ (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of+ { _creAppFun ->+ (case (_creAppFun) of+ { _lhsOcreAppFun ->+ (case ([]) of+ { _creLamArgL ->+ (case (_creLamArgL) of+ { _lhsOcreLamArgL ->+ (case (_cre) of+ { _creLamBody ->+ (case (_creLamBody) of+ { _lhsOcreLamBody ->+ (case (_crse) of+ { _lhsOcrse ->+ (case (Nothing) of+ { _lhsOmbFFIApp ->+ (case (Nothing) of+ { _lhsOmbLam ->+ (case (Nothing) of+ { _lhsOmbVar ->+ (case (0) of+ { _lhsOrefOffsetMax ->+ (case (_lhsIstackDepth + 1) of+ { _stackDepthHere ->+ (case (_stackDepthHere) of+ { _lhsOstackDepth ->+ (case (_stackDepthHere) of+ { _lhsOstackDepthMax ->+ (case (panic "Core.ToCoreRun.CExpr.ref") of+ { _vref ->+ (case (_vref) of+ { _lhsOvref ->+ ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_Integer_2)) of+ { ( sem_CExpr_2) ->+ ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }))+ in sem_CExpr_Integer_1)) of+ { ( sem_CExpr_1) ->+ ( _lhsOwhatBelow,sem_CExpr_1) }) }) })+sem_CExpr_Tup :: CTag ->+ T_CExpr+sem_CExpr_Tup tag_ =+ (case (ExprIsTup tag_) of+ { _whatBelow ->+ (case (_whatBelow) of+ { _lhsOwhatBelow ->+ (case ((let sem_CExpr_Tup_1 :: T_CExpr_1+ sem_CExpr_Tup_1 =+ (\ _lhsIlev+ _lhsIrefOffset+ _lhsIwhatAbove ->+ (case (CR.emptyNm2RefMp) of+ { _lhsOnm2refGath ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CExpr_Tup_2 :: T_CExpr_2+ sem_CExpr_Tup_2 =+ (\ _lhsIevalCtx+ _lhsIimpNmLkup+ _lhsIisTopApp+ _lhsIisTopTup+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth+ _lhsItailCtx ->+ (case (AppFunKind_Tag tag_) of+ { _lhsOappFunKind ->+ (case ([]) of+ { _lhsOcrb ->+ (case (CR.mkTup (ctagTag tag_) []) of+ { _creBase ->+ (case (_creBase) of+ { _cre ->+ (case (_cre) of+ { _lhsOcre ->+ (case ([]) of+ { _creAppArgL ->+ (case (_creAppArgL) of+ { _lhsOcreAppArgL ->+ (case (\_ -> cseCtxWrap TailCtx_Plain . CR.mkTup' (ctagTag tag_)) of+ { _creAppFun ->+ (case (_creAppFun) of+ { _lhsOcreAppFun ->+ (case ([]) of+ { _creLamArgL ->+ (case (_creLamArgL) of+ { _lhsOcreLamArgL ->+ (case (_cre) of+ { _creLamBody ->+ (case (_creLamBody) of+ { _lhsOcreLamBody ->+ (case (panic "Core.ToCoreRun.CExpr.crse") of+ { _crse ->+ (case (_crse) of+ { _lhsOcrse ->+ (case (Nothing) of+ { _lhsOmbFFIApp ->+ (case (Nothing) of+ { _lhsOmbLam ->+ (case (Nothing) of+ { _lhsOmbVar ->+ (case (0) of+ { _lhsOrefOffsetMax ->+ (case (_lhsIstackDepth + 1) of+ { _stackDepthHere ->+ (case (_stackDepthHere) of+ { _lhsOstackDepth ->+ (case (_stackDepthHere) of+ { _lhsOstackDepthMax ->+ (case (panic "Core.ToCoreRun.CExpr.ref") of+ { _vref ->+ (case (_vref) of+ { _lhsOvref ->+ ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_Tup_2)) of+ { ( sem_CExpr_2) ->+ ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }))+ in sem_CExpr_Tup_1)) of+ { ( sem_CExpr_1) ->+ ( _lhsOwhatBelow,sem_CExpr_1) }) }) })+sem_CExpr_Let :: CBindCateg ->+ T_CBindL ->+ T_CExpr ->+ T_CExpr+sem_CExpr_Let categ_ binds_ body_ =+ (case (ExprIsOther) of+ { _whatBelow ->+ (case (_whatBelow) of+ { _lhsOwhatBelow ->+ (case ((let sem_CExpr_Let_1 :: T_CExpr_1+ sem_CExpr_Let_1 =+ (\ _lhsIlev+ _lhsIrefOffset+ _lhsIwhatAbove ->+ (case (ExprIsOther) of+ { _whatAbove ->+ (case (_whatAbove) of+ { _bodyOwhatAbove ->+ (case (_lhsIrefOffset) of+ { _bindsOrefOffset ->+ (case (_lhsIlev) of+ { _bindsOlev ->+ (case (_lhsIlev == cLevModule) of+ { _isGlobal ->+ (case (_isGlobal) of+ { _bindsOisGlobal ->+ (case (binds_ _bindsOisGlobal _bindsOlev _bindsOrefOffset) of+ { ( _bindsInm2refGath,_bindsIrefOffset,binds_1) ->+ (case (_bindsIrefOffset) of+ { _bodyOrefOffset ->+ (case (_lhsIlev) of+ { _bodyOlev ->+ (case (body_) of+ { ( _bodyIwhatBelow,body_1) ->+ (case (body_1 _bodyOlev _bodyOrefOffset _bodyOwhatAbove) of+ { ( _bodyInm2refGath,_bodyIrefOffset,body_2) ->+ (case (if _isGlobal+ then (CR.emptyNm2RefMp, _bindsInm2refGath `CR.nm2refUnion` _bodyInm2refGath)+ else (_bindsInm2refGath, CR.emptyNm2RefMp)) of+ { __tup1 ->+ (case (__tup1) of+ { (_,_lhsOnm2refGath) ->+ (case (_bodyIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CExpr_Let_2 :: T_CExpr_2+ sem_CExpr_Let_2 =+ (\ _lhsIevalCtx+ _lhsIimpNmLkup+ _lhsIisTopApp+ _lhsIisTopTup+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth+ _lhsItailCtx ->+ (case (AppFunKind_NoApp) of+ { _lhsOappFunKind ->+ (case (_lhsIstackDepth) of+ { _bindsOstackDepth ->+ (case (if categ_ == CBindCateg_Strict+ then EvalCtx_Eval+ else EvalCtx_Thunk) of+ { _evalCtx ->+ (case (_evalCtx) of+ { _bindsOevalCtx ->+ (case (_lhsIopts) of+ { _bindsOopts ->+ (case (_lhsImodNr) of+ { _bindsOmodNr ->+ (case (categ_) of+ { _letBindingsCateg ->+ (case (_letBindingsCateg) of+ { _bindsOletBindingsCateg ->+ (case (_lhsIimpNmLkup) of+ { _bindsOimpNmLkup ->+ (case (if _isGlobal+ then (_lhsInm2ref, _lhsInm2ref)+ else ( case categ_ of+ CBindCateg_Rec -> _bindsInm2refGath `CR.nm2refUnion` _lhsInm2ref+ _ -> _lhsInm2ref `CR.nm2refUnion` _bindsInm2refGath+ , _bindsInm2refGath `CR.nm2refUnion` _lhsInm2ref+ )) of+ { __tup2 ->+ (case (__tup2) of+ { (_bindsOnm2ref,_) ->+ (case (binds_1 _bindsOevalCtx _bindsOimpNmLkup _bindsOletBindingsCateg _bindsOmodNr _bindsOnm2ref _bindsOopts _bindsOstackDepth) of+ { ( _bindsIcrb,_bindsIrefOffsetMax,_bindsIstackDepth,_bindsIstackDepthMax) ->+ (case (_bindsIstackDepth) of+ { _bodyOstackDepth ->+ (case (_lhsIimpNmLkup) of+ { _bodyOimpNmLkup ->+ (case (__tup2) of+ { (_,_bodyOnm2ref) ->+ (case (_lhsItailCtx) of+ { _bodyOtailCtx ->+ (case (_lhsIopts) of+ { _bodyOopts ->+ (case (_lhsImodNr) of+ { _bodyOmodNr ->+ (case (True) of+ { _isTopTup ->+ (case (_isTopTup) of+ { _bodyOisTopTup ->+ (case (True) of+ { _isTopApp ->+ (case (_isTopApp) of+ { _bodyOisTopApp ->+ (case (_evalCtx) of+ { _bodyOevalCtx ->+ (case (body_2 _bodyOevalCtx _bodyOimpNmLkup _bodyOisTopApp _bodyOisTopTup _bodyOmodNr _bodyOnm2ref _bodyOopts _bodyOstackDepth _bodyOtailCtx) of+ { ( _bodyIappFunKind,_bodyIcrb,_bodyIcre,_bodyIcreAppArgL,_bodyIcreAppFun,_bodyIcreLamArgL,_bodyIcreLamBody,_bodyIcrse,_bodyImbFFIApp,_bodyImbLam,_bodyImbVar,_bodyIrefOffsetMax,_bodyIstackDepth,_bodyIstackDepthMax,_bodyIvref) ->+ (case (if _isGlobal+ then _bindsIcrb ++ _bodyIcrb+ else []) of+ { _lhsOcrb ->+ (case (__tup1) of+ { (_nm2refNew,_) ->+ (case (if _isGlobal+ then _bodyIcre+ else CR.Exp_Let _lhsIrefOffset (CR.nm2RefMpInverse _nm2refNew) (CR.crarrayFromList $ map snd _bindsIcrb) _bodyIcre) of+ { _creBase ->+ (case (_creBase) of+ { _cre ->+ (case (_cre) of+ { _lhsOcre ->+ (case ([]) of+ { _creAppArgL ->+ (case (_creAppArgL) of+ { _lhsOcreAppArgL ->+ (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of+ { _creAppFun ->+ (case (_creAppFun) of+ { _lhsOcreAppFun ->+ (case ([]) of+ { _creLamArgL ->+ (case (_creLamArgL) of+ { _lhsOcreLamArgL ->+ (case (_cre) of+ { _creLamBody ->+ (case (_creLamBody) of+ { _lhsOcreLamBody ->+ (case (panic "Core.ToCoreRun.CExpr.crse") of+ { _crse ->+ (case (_crse) of+ { _lhsOcrse ->+ (case (Nothing) of+ { _lhsOmbFFIApp ->+ (case (Nothing) of+ { _lhsOmbLam ->+ (case (Nothing) of+ { _lhsOmbVar ->+ (case (max _bindsIrefOffsetMax _bodyIrefOffsetMax) of+ { _refOffsetMax ->+ (case (_refOffsetMax) of+ { _lhsOrefOffsetMax ->+ (case (_bodyIstackDepth) of+ { _lhsOstackDepth ->+ (case (max _bindsIstackDepthMax _bodyIstackDepthMax) of+ { _stackDepthMax ->+ (case (_stackDepthMax) of+ { _lhsOstackDepthMax ->+ (case (panic "Core.ToCoreRun.CExpr.ref") of+ { _vref ->+ (case (_vref) of+ { _lhsOvref ->+ ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_Let_2)) of+ { ( sem_CExpr_2) ->+ ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_Let_1)) of+ { ( sem_CExpr_1) ->+ ( _lhsOwhatBelow,sem_CExpr_1) }) }) })+sem_CExpr_App :: T_CExpr ->+ T_CBound ->+ T_CExpr+sem_CExpr_App func_ arg_ =+ (case (func_) of+ { ( _funcIwhatBelow,func_1) ->+ (case (maybe (ExprIsApp 1 _funcIwhatBelow) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _funcIwhatBelow) of+ { _whatBelow ->+ (case (_whatBelow) of+ { _lhsOwhatBelow ->+ (case ((let sem_CExpr_App_1 :: T_CExpr_1+ sem_CExpr_App_1 =+ (\ _lhsIlev+ _lhsIrefOffset+ _lhsIwhatAbove ->+ (case (_lhsIrefOffset) of+ { _funcOrefOffset ->+ (case (maybe (ExprIsApp 1 ExprIsOther) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _lhsIwhatAbove) of+ { _whatAbove ->+ (case (_whatAbove) of+ { _funcOwhatAbove ->+ (case (_lhsIlev) of+ { _funcOlev ->+ (case (func_1 _funcOlev _funcOrefOffset _funcOwhatAbove) of+ { ( _funcInm2refGath,_funcIrefOffset,func_2) ->+ (case (_funcIrefOffset) of+ { _argOrefOffset ->+ (case (_lhsIlev) of+ { _argOlev ->+ (case (False) of+ { _isGlobal ->+ (case (_isGlobal) of+ { _argOisGlobal ->+ (case (hsnUnknown) of+ { _argOnm ->+ (case (EvalCtx_Thunk) of+ { _argOevalCtx ->+ (case (arg_ _argOevalCtx _argOisGlobal _argOlev _argOnm _argOrefOffset) of+ { ( _argInm2refGath,_argIrefOffset,arg_1) ->+ (case (_funcInm2refGath `CR.nm2refUnion` _argInm2refGath) of+ { _lhsOnm2refGath ->+ (case (_argIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CExpr_App_2 :: T_CExpr_2+ sem_CExpr_App_2 =+ (\ _lhsIevalCtx+ _lhsIimpNmLkup+ _lhsIisTopApp+ _lhsIisTopTup+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth+ _lhsItailCtx ->+ (case (TailCtx_Plain) of+ { _tailCtx ->+ (case (_tailCtx) of+ { _funcOtailCtx ->+ (case (_lhsIstackDepth) of+ { _funcOstackDepth ->+ (case (_lhsIopts) of+ { _funcOopts ->+ (case (_lhsInm2ref) of+ { _funcOnm2ref ->+ (case (_lhsImodNr) of+ { _funcOmodNr ->+ (case (True) of+ { _isTopTup ->+ (case (_isTopTup) of+ { _funcOisTopTup ->+ (case (_lhsIimpNmLkup) of+ { _funcOimpNmLkup ->+ (case (_lhsIevalCtx) of+ { _funcOevalCtx ->+ (case (False) of+ { _funcOisTopApp ->+ (case (func_2 _funcOevalCtx _funcOimpNmLkup _funcOisTopApp _funcOisTopTup _funcOmodNr _funcOnm2ref _funcOopts _funcOstackDepth _funcOtailCtx) of+ { ( _funcIappFunKind,_funcIcrb,_funcIcre,_funcIcreAppArgL,_funcIcreAppFun,_funcIcreLamArgL,_funcIcreLamBody,_funcIcrse,_funcImbFFIApp,_funcImbLam,_funcImbVar,_funcIrefOffsetMax,_funcIstackDepth,_funcIstackDepthMax,_funcIvref) ->+ (case (_funcIappFunKind) of+ { _lhsOappFunKind ->+ (case ([]) of+ { _lhsOcrb ->+ (case (_lhsInm2ref) of+ { _argOnm2ref ->+ (case (_lhsIimpNmLkup) of+ { _argOimpNmLkup ->+ (case (_funcIcreAppFun) of+ { _creAppFun ->+ (case (if whatExprIsTup _funcIwhatBelow || whatExprIsFFI _funcIwhatBelow then _lhsIstackDepth else _funcIstackDepth) of+ { _stackDepthFunc ->+ (case (_stackDepthFunc) of+ { _argOstackDepth ->+ (case (_lhsIopts) of+ { _argOopts ->+ (case (_lhsImodNr) of+ { _argOmodNr ->+ (case (acoreBindcategPlain) of+ { _letBindingsCateg ->+ (case (_letBindingsCateg) of+ { _argOletBindingsCateg ->+ (case (_isTopTup) of+ { _argOisTopTup ->+ (case (True) of+ { _argOisTopApp ->+ (case (arg_1 _argOimpNmLkup _argOisTopApp _argOisTopTup _argOletBindingsCateg _argOmodNr _argOnm2ref _argOopts _argOstackDepth) of+ { ( _argIcrb,_argIrefOffsetMax,_argIstackDepth,_argIstackDepthMax) ->+ (case ((CR.exp2sexp $ snd $ head _argIcrb) : _funcIcreAppArgL) of+ { _creAppArgL ->+ (case (isNothing $ whatExprMbApp _lhsIwhatAbove) of+ { _isTopApp' ->+ (case (if _isTopApp'+ then _creAppFun _lhsItailCtx $ CR.crarrayFromList $ reverse _creAppArgL+ else CR.dbg "Core.ToCoreRun.CExpr.App.cre") of+ { _creBase ->+ (case (_creBase) of+ { _cre ->+ (case (_cre) of+ { _lhsOcre ->+ (case (_creAppArgL) of+ { _lhsOcreAppArgL ->+ (case (_creAppFun) of+ { _lhsOcreAppFun ->+ (case ([]) of+ { _creLamArgL ->+ (case (_creLamArgL) of+ { _lhsOcreLamArgL ->+ (case (_cre) of+ { _creLamBody ->+ (case (_creLamBody) of+ { _lhsOcreLamBody ->+ (case (panic "Core.ToCoreRun.CExpr.crse") of+ { _crse ->+ (case (_crse) of+ { _lhsOcrse ->+ (case (_funcImbFFIApp) of+ { _lhsOmbFFIApp ->+ (case (Nothing) of+ { _lhsOmbLam ->+ (case (Nothing) of+ { _lhsOmbVar ->+ (case (_funcIrefOffsetMax `max` _argIrefOffsetMax) of+ { _lhsOrefOffsetMax ->+ (case (if _isTopApp' then _lhsIstackDepth + 1 else _argIstackDepth) of+ { _lhsOstackDepth ->+ (case (max _argIstackDepth _argIstackDepthMax) of+ { _stackDepthMax ->+ (case (_stackDepthMax) of+ { _lhsOstackDepthMax ->+ (case (panic "Core.ToCoreRun.CExpr.ref") of+ { _vref ->+ (case (_vref) of+ { _lhsOvref ->+ ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_App_2)) of+ { ( sem_CExpr_2) ->+ ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_App_1)) of+ { ( sem_CExpr_1) ->+ ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) })+sem_CExpr_Lam :: T_CBind ->+ T_CExpr ->+ T_CExpr+sem_CExpr_Lam bind_ body_ =+ (case (body_) of+ { ( _bodyIwhatBelow,body_1) ->+ (case (maybe (ExprIsLam 1 Nothing) (\a -> ExprIsLam (a + 1) Nothing) $ whatExprMbLam _bodyIwhatBelow) of+ { _whatBelow ->+ (case (_whatBelow) of+ { _lhsOwhatBelow ->+ (case ((let sem_CExpr_Lam_1 :: T_CExpr_1+ sem_CExpr_Lam_1 =+ (\ _lhsIlev+ _lhsIrefOffset+ _lhsIwhatAbove ->+ (case (case _lhsIwhatAbove of+ ExprIsLam a mbnm -> ExprIsLam (a + 1) mbnm+ ExprIsBind nm -> ExprIsLam 1 (Just nm)+ _ -> ExprIsLam 1 Nothing) of+ { _whatAbove ->+ (case (_whatAbove) of+ { _bodyOwhatAbove ->+ (case (not $ whatExprIsLam _lhsIwhatAbove) of+ { _isTopLam ->+ (case (if _isTopLam then _lhsIlev + 1 else _lhsIlev) of+ { _lev ->+ (case (_lev) of+ { _bodyOlev ->+ (case (if _isTopLam+ then (0,1)+ else (_lhsIrefOffset, _lhsIrefOffset + 1)) of+ { __tup3 ->+ (case (__tup3) of+ { (_,_refOffsetBody) ->+ (case (_refOffsetBody) of+ { _bodyOrefOffset ->+ (case (__tup3) of+ { (_refOffset,_) ->+ (case (body_1 _bodyOlev _bodyOrefOffset _bodyOwhatAbove) of+ { ( _bodyInm2refGath,_bodyIrefOffset,body_2) ->+ (case (_refOffset) of+ { _bindOrefOffset ->+ (case (_lev) of+ { _bindOlev ->+ (case (False) of+ { _isGlobal ->+ (case (_isGlobal) of+ { _bindOisGlobal ->+ (case (bind_ _bindOisGlobal _bindOlev _bindOrefOffset) of+ { ( _bindInm,_bindInm2refGath,_bindIrefOffset,bind_1) ->+ (case (Rel.insert _bindInm (CR.RRef_Loc _lev _refOffset) _bodyInm2refGath) of+ { _nm2refNew ->+ (case (if _isTopLam+ then CR.emptyNm2RefMp+ else _nm2refNew) of+ { _lhsOnm2refGath ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CExpr_Lam_2 :: T_CExpr_2+ sem_CExpr_Lam_2 =+ (\ _lhsIevalCtx+ _lhsIimpNmLkup+ _lhsIisTopApp+ _lhsIisTopTup+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth+ _lhsItailCtx ->+ (case (AppFunKind_NoApp) of+ { _lhsOappFunKind ->+ (case ([]) of+ { _lhsOcrb ->+ (case (if _isTopLam+ then _nm2refNew `CR.nm2refUnion` _lhsInm2ref+ else _lhsInm2ref) of+ { _nm2ref ->+ (case (_nm2ref) of+ { _bodyOnm2ref ->+ (case (_lhsIimpNmLkup) of+ { _bodyOimpNmLkup ->+ (case (_lhsIopts) of+ { _bodyOopts ->+ (case (_lhsImodNr) of+ { _bodyOmodNr ->+ (case (True) of+ { _isTopTup ->+ (case (_isTopTup) of+ { _bodyOisTopTup ->+ (case (True) of+ { _isTopApp ->+ (case (_isTopApp) of+ { _bodyOisTopApp ->+ (case (_lhsIevalCtx) of+ { _bodyOevalCtx ->+ (case (_refOffsetBody) of+ { _bodyOstackDepth ->+ (case (TailCtx_TailCall) of+ { _bodyOtailCtx ->+ (case (body_2 _bodyOevalCtx _bodyOimpNmLkup _bodyOisTopApp _bodyOisTopTup _bodyOmodNr _bodyOnm2ref _bodyOopts _bodyOstackDepth _bodyOtailCtx) of+ { ( _bodyIappFunKind,_bodyIcrb,_bodyIcre,_bodyIcreAppArgL,_bodyIcreAppFun,_bodyIcreLamArgL,_bodyIcreLamBody,_bodyIcrse,_bodyImbFFIApp,_bodyImbLam,_bodyImbVar,_bodyIrefOffsetMax,_bodyIstackDepth,_bodyIstackDepthMax,_bodyIvref) ->+ (case (_bindInm : _bodyIcreLamArgL) of+ { _creLamArgL ->+ (case (max _bodyIstackDepth _bodyIstackDepthMax) of+ { _stackDepthMax ->+ (case (if _isTopLam+ then CR.Exp_Lam (whatExprMbBind _lhsIwhatAbove) (length _creLamArgL) (_stackDepthMax) (CR.nm2RefMpInverse _nm2refNew) _bodyIcreLamBody+ else CR.dbg "Core.ToCoreRun.CExpr.Lam.cre") of+ { _creBase ->+ (case (cseCtxWrap _lhsItailCtx _creBase) of+ { _cre ->+ (case (_cre) of+ { _lhsOcre ->+ (case ([]) of+ { _creAppArgL ->+ (case (_creAppArgL) of+ { _lhsOcreAppArgL ->+ (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of+ { _creAppFun ->+ (case (_creAppFun) of+ { _lhsOcreAppFun ->+ (case (_creLamArgL) of+ { _lhsOcreLamArgL ->+ (case (_bodyIcreLamBody) of+ { _creLamBody ->+ (case (_creLamBody) of+ { _lhsOcreLamBody ->+ (case (panic "Core.ToCoreRun.CExpr.crse") of+ { _crse ->+ (case (_crse) of+ { _lhsOcrse ->+ (case (Nothing) of+ { _lhsOmbFFIApp ->+ (case (_bindInm) of+ { _argNm ->+ (case (Just $ maybe [_argNm] (_argNm:) _bodyImbLam) of+ { _lhsOmbLam ->+ (case (Nothing) of+ { _lhsOmbVar ->+ (case (max _bodyIrefOffset _bodyIrefOffsetMax) of+ { _refOffsetMax ->+ (case (_refOffsetMax) of+ { _lhsOrefOffsetMax ->+ (case (_bodyIstackDepth) of+ { _lhsOstackDepth ->+ (case (_stackDepthMax) of+ { _lhsOstackDepthMax ->+ (case (panic "Core.ToCoreRun.CExpr.ref") of+ { _vref ->+ (case (_vref) of+ { _lhsOvref ->+ ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_Lam_2)) of+ { ( sem_CExpr_2) ->+ ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_Lam_1)) of+ { ( sem_CExpr_1) ->+ ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) })+sem_CExpr_Case :: T_CExpr ->+ T_CAltL ->+ T_CExpr ->+ T_CExpr+sem_CExpr_Case expr_ alts_ dflt_ =+ (case (ExprIsOther) of+ { _whatBelow ->+ (case (_whatBelow) of+ { _lhsOwhatBelow ->+ (case ((let sem_CExpr_Case_1 :: T_CExpr_1+ sem_CExpr_Case_1 =+ (\ _lhsIlev+ _lhsIrefOffset+ _lhsIwhatAbove ->+ (case (ExprIsOther) of+ { _whatAbove ->+ (case (_whatAbove) of+ { _dfltOwhatAbove ->+ (case (_lhsIrefOffset) of+ { _exprOrefOffset ->+ (case (expr_) of+ { ( _exprIwhatBelow,expr_1) ->+ (case (_whatAbove) of+ { _exprOwhatAbove ->+ (case (_lhsIlev) of+ { _exprOlev ->+ (case (expr_1 _exprOlev _exprOrefOffset _exprOwhatAbove) of+ { ( _exprInm2refGath,_exprIrefOffset,expr_2) ->+ (case (_exprIrefOffset) of+ { _altsOrefOffset ->+ (case (alts_ _altsOrefOffset) of+ { ( _altsIrefOffset,alts_1) ->+ (case (_altsIrefOffset) of+ { _dfltOrefOffset ->+ (case (_lhsIlev) of+ { _dfltOlev ->+ (case (dflt_) of+ { ( _dfltIwhatBelow,dflt_1) ->+ (case (dflt_1 _dfltOlev _dfltOrefOffset _dfltOwhatAbove) of+ { ( _dfltInm2refGath,_dfltIrefOffset,dflt_2) ->+ (case (_exprInm2refGath `CR.nm2refUnion` _dfltInm2refGath) of+ { _lhsOnm2refGath ->+ (case (_dfltIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CExpr_Case_2 :: T_CExpr_2+ sem_CExpr_Case_2 =+ (\ _lhsIevalCtx+ _lhsIimpNmLkup+ _lhsIisTopApp+ _lhsIisTopTup+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth+ _lhsItailCtx ->+ (case (AppFunKind_NoApp) of+ { _lhsOappFunKind ->+ (case ([]) of+ { _lhsOcrb ->+ (case (_lhsItailCtx) of+ { _altsOtailCtx ->+ (case (_lhsInm2ref) of+ { _altsOnm2ref ->+ (case (_lhsIlev) of+ { _altsOlev ->+ (case (_lhsIimpNmLkup) of+ { _altsOimpNmLkup ->+ (case (_lhsInm2ref) of+ { _exprOnm2ref ->+ (case (_lhsIimpNmLkup) of+ { _exprOimpNmLkup ->+ (case (maybe CR.noRRef (\n -> maybe (CR.RRef_Dbg n) id $ CR.nm2refLookup n _lhsInm2ref) $ whatExprMbVar _exprIwhatBelow) of+ { _altsOscrutRef ->+ (case (_lhsIstackDepth) of+ { _altsOstackDepth ->+ (case (_lhsIopts) of+ { _altsOopts ->+ (case (_lhsImodNr) of+ { _altsOmodNr ->+ (case (_lhsIevalCtx) of+ { _altsOevalCtx ->+ (case (alts_1 _altsOevalCtx _altsOimpNmLkup _altsOlev _altsOmodNr _altsOnm2ref _altsOopts _altsOscrutRef _altsOstackDepth _altsOtailCtx) of+ { ( _altsIcra,_altsIrefOffsetMax,_altsIstackDepth,_altsIstackDepthMax) ->+ (case (_lhsIstackDepth) of+ { _exprOstackDepth ->+ (case (_lhsIopts) of+ { _exprOopts ->+ (case (_lhsImodNr) of+ { _exprOmodNr ->+ (case (True) of+ { _isTopTup ->+ (case (_isTopTup) of+ { _exprOisTopTup ->+ (case (True) of+ { _isTopApp ->+ (case (_isTopApp) of+ { _exprOisTopApp ->+ (case (_lhsIevalCtx) of+ { _exprOevalCtx ->+ (case (TailCtx_Plain) of+ { _exprOtailCtx ->+ (case (expr_2 _exprOevalCtx _exprOimpNmLkup _exprOisTopApp _exprOisTopTup _exprOmodNr _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of+ { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax,_exprIvref) ->+ (case (CR.Exp_Case (CR.mkVar' $ CR.RRef_Tag _exprIvref) $ CR.crarrayFromList _altsIcra) of+ { _creBase ->+ (case (_creBase) of+ { _cre ->+ (case (_cre) of+ { _lhsOcre ->+ (case ([]) of+ { _creAppArgL ->+ (case (_creAppArgL) of+ { _lhsOcreAppArgL ->+ (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of+ { _creAppFun ->+ (case (_creAppFun) of+ { _lhsOcreAppFun ->+ (case ([]) of+ { _creLamArgL ->+ (case (_creLamArgL) of+ { _lhsOcreLamArgL ->+ (case (_cre) of+ { _creLamBody ->+ (case (_creLamBody) of+ { _lhsOcreLamBody ->+ (case (panic "Core.ToCoreRun.CExpr.crse") of+ { _crse ->+ (case (_crse) of+ { _lhsOcrse ->+ (case (Nothing) of+ { _lhsOmbFFIApp ->+ (case (Nothing) of+ { _lhsOmbLam ->+ (case (Nothing) of+ { _lhsOmbVar ->+ (case (_lhsItailCtx) of+ { _dfltOtailCtx ->+ (case (_altsIstackDepth) of+ { _dfltOstackDepth ->+ (case (_lhsIopts) of+ { _dfltOopts ->+ (case (_lhsInm2ref) of+ { _dfltOnm2ref ->+ (case (_lhsImodNr) of+ { _dfltOmodNr ->+ (case (_isTopTup) of+ { _dfltOisTopTup ->+ (case (_isTopApp) of+ { _dfltOisTopApp ->+ (case (_lhsIimpNmLkup) of+ { _dfltOimpNmLkup ->+ (case (_lhsIevalCtx) of+ { _dfltOevalCtx ->+ (case (dflt_2 _dfltOevalCtx _dfltOimpNmLkup _dfltOisTopApp _dfltOisTopTup _dfltOmodNr _dfltOnm2ref _dfltOopts _dfltOstackDepth _dfltOtailCtx) of+ { ( _dfltIappFunKind,_dfltIcrb,_dfltIcre,_dfltIcreAppArgL,_dfltIcreAppFun,_dfltIcreLamArgL,_dfltIcreLamBody,_dfltIcrse,_dfltImbFFIApp,_dfltImbLam,_dfltImbVar,_dfltIrefOffsetMax,_dfltIstackDepth,_dfltIstackDepthMax,_dfltIvref) ->+ (case (_exprIrefOffsetMax `max` _altsIrefOffsetMax `max` _dfltIrefOffsetMax) of+ { _lhsOrefOffsetMax ->+ (case (_lhsIstackDepth + 1) of+ { _stackDepthHere ->+ (case (_stackDepthHere) of+ { _lhsOstackDepth ->+ (case (max _exprIstackDepthMax _altsIstackDepthMax) of+ { _stackDepthMax ->+ (case (_stackDepthMax) of+ { _lhsOstackDepthMax ->+ (case (panic "Core.ToCoreRun.CExpr.ref") of+ { _vref ->+ (case (_vref) of+ { _lhsOvref ->+ ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_Case_2)) of+ { ( sem_CExpr_2) ->+ ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_Case_1)) of+ { ( sem_CExpr_1) ->+ ( _lhsOwhatBelow,sem_CExpr_1) }) }) })+sem_CExpr_CaseAltFail :: CaseAltFailReason ->+ T_CExpr ->+ T_CExpr+sem_CExpr_CaseAltFail failReason_ errorExpr_ =+ (case (errorExpr_) of+ { ( _errorExprIwhatBelow,errorExpr_1) ->+ (case (_errorExprIwhatBelow) of+ { _lhsOwhatBelow ->+ (case ((let sem_CExpr_CaseAltFail_1 :: T_CExpr_1+ sem_CExpr_CaseAltFail_1 =+ (\ _lhsIlev+ _lhsIrefOffset+ _lhsIwhatAbove ->+ (case (ExprIsOther) of+ { _whatAbove ->+ (case (_whatAbove) of+ { _errorExprOwhatAbove ->+ (case (_lhsIrefOffset) of+ { _errorExprOrefOffset ->+ (case (_lhsIlev) of+ { _errorExprOlev ->+ (case (errorExpr_1 _errorExprOlev _errorExprOrefOffset _errorExprOwhatAbove) of+ { ( _errorExprInm2refGath,_errorExprIrefOffset,errorExpr_2) ->+ (case (_errorExprInm2refGath) of+ { _lhsOnm2refGath ->+ (case (_errorExprIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CExpr_CaseAltFail_2 :: T_CExpr_2+ sem_CExpr_CaseAltFail_2 =+ (\ _lhsIevalCtx+ _lhsIimpNmLkup+ _lhsIisTopApp+ _lhsIisTopTup+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth+ _lhsItailCtx ->+ (case (_lhsItailCtx) of+ { _errorExprOtailCtx ->+ (case (_lhsIstackDepth) of+ { _errorExprOstackDepth ->+ (case (_lhsIopts) of+ { _errorExprOopts ->+ (case (_lhsInm2ref) of+ { _errorExprOnm2ref ->+ (case (_lhsImodNr) of+ { _errorExprOmodNr ->+ (case (True) of+ { _isTopTup ->+ (case (_isTopTup) of+ { _errorExprOisTopTup ->+ (case (True) of+ { _isTopApp ->+ (case (_isTopApp) of+ { _errorExprOisTopApp ->+ (case (_lhsIimpNmLkup) of+ { _errorExprOimpNmLkup ->+ (case (_lhsIevalCtx) of+ { _errorExprOevalCtx ->+ (case (errorExpr_2 _errorExprOevalCtx _errorExprOimpNmLkup _errorExprOisTopApp _errorExprOisTopTup _errorExprOmodNr _errorExprOnm2ref _errorExprOopts _errorExprOstackDepth _errorExprOtailCtx) of+ { ( _errorExprIappFunKind,_errorExprIcrb,_errorExprIcre,_errorExprIcreAppArgL,_errorExprIcreAppFun,_errorExprIcreLamArgL,_errorExprIcreLamBody,_errorExprIcrse,_errorExprImbFFIApp,_errorExprImbLam,_errorExprImbVar,_errorExprIrefOffsetMax,_errorExprIstackDepth,_errorExprIstackDepthMax,_errorExprIvref) ->+ (case (_errorExprIappFunKind) of+ { _lhsOappFunKind ->+ (case ([]) of+ { _lhsOcrb ->+ (case (CR.dbg "Core.ToCoreRun.CExpr.cre") of+ { _creBase ->+ (case (cseCtxWrap _lhsItailCtx _creBase) of+ { _cre ->+ (case (_cre) of+ { _lhsOcre ->+ (case ([]) of+ { _creAppArgL ->+ (case (_creAppArgL) of+ { _lhsOcreAppArgL ->+ (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of+ { _creAppFun ->+ (case (_creAppFun) of+ { _lhsOcreAppFun ->+ (case ([]) of+ { _creLamArgL ->+ (case (_creLamArgL) of+ { _lhsOcreLamArgL ->+ (case (_cre) of+ { _creLamBody ->+ (case (_creLamBody) of+ { _lhsOcreLamBody ->+ (case (panic "Core.ToCoreRun.CExpr.crse") of+ { _crse ->+ (case (_crse) of+ { _lhsOcrse ->+ (case (Nothing) of+ { _lhsOmbFFIApp ->+ (case (_errorExprImbLam) of+ { _lhsOmbLam ->+ (case (_errorExprImbVar) of+ { _lhsOmbVar ->+ (case (_errorExprIrefOffsetMax) of+ { _lhsOrefOffsetMax ->+ (case (_lhsIstackDepth + 1) of+ { _stackDepthHere ->+ (case (_stackDepthHere) of+ { _lhsOstackDepth ->+ (case (_stackDepthHere) of+ { _lhsOstackDepthMax ->+ (case (panic "Core.ToCoreRun.CExpr.ref") of+ { _vref ->+ (case (_vref) of+ { _lhsOvref ->+ ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_CaseAltFail_2)) of+ { ( sem_CExpr_2) ->+ ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }))+ in sem_CExpr_CaseAltFail_1)) of+ { ( sem_CExpr_1) ->+ ( _lhsOwhatBelow,sem_CExpr_1) }) }) })+sem_CExpr_TupDel :: T_CExpr ->+ CTag ->+ HsName ->+ T_CExpr ->+ T_CExpr+sem_CExpr_TupDel expr_ tag_ nm_ offset_ =+ (case (ExprIsOther) of+ { _whatBelow ->+ (case (_whatBelow) of+ { _lhsOwhatBelow ->+ (case ((let sem_CExpr_TupDel_1 :: T_CExpr_1+ sem_CExpr_TupDel_1 =+ (\ _lhsIlev+ _lhsIrefOffset+ _lhsIwhatAbove ->+ (case (ExprIsOther) of+ { _whatAbove ->+ (case (_whatAbove) of+ { _offsetOwhatAbove ->+ (case (_lhsIrefOffset) of+ { _exprOrefOffset ->+ (case (expr_) of+ { ( _exprIwhatBelow,expr_1) ->+ (case (_whatAbove) of+ { _exprOwhatAbove ->+ (case (_lhsIlev) of+ { _exprOlev ->+ (case (expr_1 _exprOlev _exprOrefOffset _exprOwhatAbove) of+ { ( _exprInm2refGath,_exprIrefOffset,expr_2) ->+ (case (_exprIrefOffset) of+ { _offsetOrefOffset ->+ (case (_lhsIlev) of+ { _offsetOlev ->+ (case (offset_) of+ { ( _offsetIwhatBelow,offset_1) ->+ (case (offset_1 _offsetOlev _offsetOrefOffset _offsetOwhatAbove) of+ { ( _offsetInm2refGath,_offsetIrefOffset,offset_2) ->+ (case (_exprInm2refGath `CR.nm2refUnion` _offsetInm2refGath) of+ { _lhsOnm2refGath ->+ (case (_offsetIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CExpr_TupDel_2 :: T_CExpr_2+ sem_CExpr_TupDel_2 =+ (\ _lhsIevalCtx+ _lhsIimpNmLkup+ _lhsIisTopApp+ _lhsIisTopTup+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth+ _lhsItailCtx ->+ (case (AppFunKind_NoApp) of+ { _lhsOappFunKind ->+ (case ([]) of+ { _lhsOcrb ->+ (case (CR.dbg "Core.ToCoreRun.CExpr.cre") of+ { _creBase ->+ (case (cseCtxWrap _lhsItailCtx _creBase) of+ { _cre ->+ (case (_cre) of+ { _lhsOcre ->+ (case ([]) of+ { _creAppArgL ->+ (case (_creAppArgL) of+ { _lhsOcreAppArgL ->+ (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of+ { _creAppFun ->+ (case (_creAppFun) of+ { _lhsOcreAppFun ->+ (case ([]) of+ { _creLamArgL ->+ (case (_creLamArgL) of+ { _lhsOcreLamArgL ->+ (case (_cre) of+ { _creLamBody ->+ (case (_creLamBody) of+ { _lhsOcreLamBody ->+ (case (panic "Core.ToCoreRun.CExpr.crse") of+ { _crse ->+ (case (_crse) of+ { _lhsOcrse ->+ (case (Nothing) of+ { _lhsOmbFFIApp ->+ (case (Nothing) of+ { _lhsOmbLam ->+ (case (Nothing) of+ { _lhsOmbVar ->+ (case (_lhsItailCtx) of+ { _offsetOtailCtx ->+ (case (_lhsIstackDepth) of+ { _exprOstackDepth ->+ (case (_lhsItailCtx) of+ { _exprOtailCtx ->+ (case (_lhsIopts) of+ { _exprOopts ->+ (case (_lhsInm2ref) of+ { _exprOnm2ref ->+ (case (_lhsImodNr) of+ { _exprOmodNr ->+ (case (True) of+ { _isTopApp ->+ (case (_isTopApp) of+ { _exprOisTopApp ->+ (case (_lhsIimpNmLkup) of+ { _exprOimpNmLkup ->+ (case (_lhsIevalCtx) of+ { _exprOevalCtx ->+ (case (False) of+ { _exprOisTopTup ->+ (case (expr_2 _exprOevalCtx _exprOimpNmLkup _exprOisTopApp _exprOisTopTup _exprOmodNr _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of+ { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax,_exprIvref) ->+ (case (_exprIstackDepth) of+ { _offsetOstackDepth ->+ (case (_lhsIopts) of+ { _offsetOopts ->+ (case (_lhsInm2ref) of+ { _offsetOnm2ref ->+ (case (_lhsImodNr) of+ { _offsetOmodNr ->+ (case (True) of+ { _isTopTup ->+ (case (_isTopTup) of+ { _offsetOisTopTup ->+ (case (_isTopApp) of+ { _offsetOisTopApp ->+ (case (_lhsIimpNmLkup) of+ { _offsetOimpNmLkup ->+ (case (_lhsIevalCtx) of+ { _offsetOevalCtx ->+ (case (offset_2 _offsetOevalCtx _offsetOimpNmLkup _offsetOisTopApp _offsetOisTopTup _offsetOmodNr _offsetOnm2ref _offsetOopts _offsetOstackDepth _offsetOtailCtx) of+ { ( _offsetIappFunKind,_offsetIcrb,_offsetIcre,_offsetIcreAppArgL,_offsetIcreAppFun,_offsetIcreLamArgL,_offsetIcreLamBody,_offsetIcrse,_offsetImbFFIApp,_offsetImbLam,_offsetImbVar,_offsetIrefOffsetMax,_offsetIstackDepth,_offsetIstackDepthMax,_offsetIvref) ->+ (case (_exprIrefOffsetMax `max` _offsetIrefOffsetMax) of+ { _lhsOrefOffsetMax ->+ (case (_lhsIstackDepth + 1) of+ { _stackDepthHere ->+ (case (_stackDepthHere) of+ { _lhsOstackDepth ->+ (case (_stackDepthHere) of+ { _lhsOstackDepthMax ->+ (case (panic "Core.ToCoreRun.CExpr.ref") of+ { _vref ->+ (case (_vref) of+ { _lhsOvref ->+ ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_TupDel_2)) of+ { ( sem_CExpr_2) ->+ ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_TupDel_1)) of+ { ( sem_CExpr_1) ->+ ( _lhsOwhatBelow,sem_CExpr_1) }) }) })+sem_CExpr_TupIns :: T_CExpr ->+ CTag ->+ HsName ->+ T_CExpr ->+ T_CExpr ->+ T_CExpr+sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ =+ (case (ExprIsOther) of+ { _whatBelow ->+ (case (_whatBelow) of+ { _lhsOwhatBelow ->+ (case ((let sem_CExpr_TupIns_1 :: T_CExpr_1+ sem_CExpr_TupIns_1 =+ (\ _lhsIlev+ _lhsIrefOffset+ _lhsIwhatAbove ->+ (case (ExprIsOther) of+ { _whatAbove ->+ (case (_whatAbove) of+ { _fldExprOwhatAbove ->+ (case (_lhsIrefOffset) of+ { _exprOrefOffset ->+ (case (expr_) of+ { ( _exprIwhatBelow,expr_1) ->+ (case (_whatAbove) of+ { _exprOwhatAbove ->+ (case (_lhsIlev) of+ { _exprOlev ->+ (case (expr_1 _exprOlev _exprOrefOffset _exprOwhatAbove) of+ { ( _exprInm2refGath,_exprIrefOffset,expr_2) ->+ (case (_exprIrefOffset) of+ { _offsetOrefOffset ->+ (case (offset_) of+ { ( _offsetIwhatBelow,offset_1) ->+ (case (_whatAbove) of+ { _offsetOwhatAbove ->+ (case (_lhsIlev) of+ { _offsetOlev ->+ (case (offset_1 _offsetOlev _offsetOrefOffset _offsetOwhatAbove) of+ { ( _offsetInm2refGath,_offsetIrefOffset,offset_2) ->+ (case (_offsetIrefOffset) of+ { _fldExprOrefOffset ->+ (case (_lhsIlev) of+ { _fldExprOlev ->+ (case (fldExpr_) of+ { ( _fldExprIwhatBelow,fldExpr_1) ->+ (case (fldExpr_1 _fldExprOlev _fldExprOrefOffset _fldExprOwhatAbove) of+ { ( _fldExprInm2refGath,_fldExprIrefOffset,fldExpr_2) ->+ (case (_exprInm2refGath `CR.nm2refUnion` _offsetInm2refGath `CR.nm2refUnion` _fldExprInm2refGath) of+ { _lhsOnm2refGath ->+ (case (_fldExprIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CExpr_TupIns_2 :: T_CExpr_2+ sem_CExpr_TupIns_2 =+ (\ _lhsIevalCtx+ _lhsIimpNmLkup+ _lhsIisTopApp+ _lhsIisTopTup+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth+ _lhsItailCtx ->+ (case (AppFunKind_NoApp) of+ { _lhsOappFunKind ->+ (case ([]) of+ { _lhsOcrb ->+ (case (CR.dbg "Core.ToCoreRun.CExpr.cre") of+ { _creBase ->+ (case (cseCtxWrap _lhsItailCtx _creBase) of+ { _cre ->+ (case (_cre) of+ { _lhsOcre ->+ (case ([]) of+ { _creAppArgL ->+ (case (_creAppArgL) of+ { _lhsOcreAppArgL ->+ (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of+ { _creAppFun ->+ (case (_creAppFun) of+ { _lhsOcreAppFun ->+ (case ([]) of+ { _creLamArgL ->+ (case (_creLamArgL) of+ { _lhsOcreLamArgL ->+ (case (_cre) of+ { _creLamBody ->+ (case (_creLamBody) of+ { _lhsOcreLamBody ->+ (case (panic "Core.ToCoreRun.CExpr.crse") of+ { _crse ->+ (case (_crse) of+ { _lhsOcrse ->+ (case (Nothing) of+ { _lhsOmbFFIApp ->+ (case (Nothing) of+ { _lhsOmbLam ->+ (case (Nothing) of+ { _lhsOmbVar ->+ (case (_lhsItailCtx) of+ { _fldExprOtailCtx ->+ (case (_lhsIstackDepth) of+ { _exprOstackDepth ->+ (case (_lhsItailCtx) of+ { _exprOtailCtx ->+ (case (_lhsIopts) of+ { _exprOopts ->+ (case (_lhsInm2ref) of+ { _exprOnm2ref ->+ (case (_lhsImodNr) of+ { _exprOmodNr ->+ (case (True) of+ { _isTopApp ->+ (case (_isTopApp) of+ { _exprOisTopApp ->+ (case (_lhsIimpNmLkup) of+ { _exprOimpNmLkup ->+ (case (_lhsIevalCtx) of+ { _exprOevalCtx ->+ (case (False) of+ { _exprOisTopTup ->+ (case (expr_2 _exprOevalCtx _exprOimpNmLkup _exprOisTopApp _exprOisTopTup _exprOmodNr _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of+ { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax,_exprIvref) ->+ (case (_exprIstackDepth) of+ { _offsetOstackDepth ->+ (case (_lhsItailCtx) of+ { _offsetOtailCtx ->+ (case (_lhsIopts) of+ { _offsetOopts ->+ (case (_lhsInm2ref) of+ { _offsetOnm2ref ->+ (case (_lhsImodNr) of+ { _offsetOmodNr ->+ (case (True) of+ { _isTopTup ->+ (case (_isTopTup) of+ { _offsetOisTopTup ->+ (case (_isTopApp) of+ { _offsetOisTopApp ->+ (case (_lhsIimpNmLkup) of+ { _offsetOimpNmLkup ->+ (case (_lhsIevalCtx) of+ { _offsetOevalCtx ->+ (case (offset_2 _offsetOevalCtx _offsetOimpNmLkup _offsetOisTopApp _offsetOisTopTup _offsetOmodNr _offsetOnm2ref _offsetOopts _offsetOstackDepth _offsetOtailCtx) of+ { ( _offsetIappFunKind,_offsetIcrb,_offsetIcre,_offsetIcreAppArgL,_offsetIcreAppFun,_offsetIcreLamArgL,_offsetIcreLamBody,_offsetIcrse,_offsetImbFFIApp,_offsetImbLam,_offsetImbVar,_offsetIrefOffsetMax,_offsetIstackDepth,_offsetIstackDepthMax,_offsetIvref) ->+ (case (_offsetIstackDepth) of+ { _fldExprOstackDepth ->+ (case (_lhsIopts) of+ { _fldExprOopts ->+ (case (_lhsInm2ref) of+ { _fldExprOnm2ref ->+ (case (_lhsImodNr) of+ { _fldExprOmodNr ->+ (case (_isTopTup) of+ { _fldExprOisTopTup ->+ (case (_isTopApp) of+ { _fldExprOisTopApp ->+ (case (_lhsIimpNmLkup) of+ { _fldExprOimpNmLkup ->+ (case (_lhsIevalCtx) of+ { _fldExprOevalCtx ->+ (case (fldExpr_2 _fldExprOevalCtx _fldExprOimpNmLkup _fldExprOisTopApp _fldExprOisTopTup _fldExprOmodNr _fldExprOnm2ref _fldExprOopts _fldExprOstackDepth _fldExprOtailCtx) of+ { ( _fldExprIappFunKind,_fldExprIcrb,_fldExprIcre,_fldExprIcreAppArgL,_fldExprIcreAppFun,_fldExprIcreLamArgL,_fldExprIcreLamBody,_fldExprIcrse,_fldExprImbFFIApp,_fldExprImbLam,_fldExprImbVar,_fldExprIrefOffsetMax,_fldExprIstackDepth,_fldExprIstackDepthMax,_fldExprIvref) ->+ (case (_exprIrefOffsetMax `max` _offsetIrefOffsetMax `max` _fldExprIrefOffsetMax) of+ { _lhsOrefOffsetMax ->+ (case (_lhsIstackDepth + 1) of+ { _stackDepthHere ->+ (case (_stackDepthHere) of+ { _lhsOstackDepth ->+ (case (_stackDepthHere) of+ { _lhsOstackDepthMax ->+ (case (panic "Core.ToCoreRun.CExpr.ref") of+ { _vref ->+ (case (_vref) of+ { _lhsOvref ->+ ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_TupIns_2)) of+ { ( sem_CExpr_2) ->+ ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_TupIns_1)) of+ { ( sem_CExpr_1) ->+ ( _lhsOwhatBelow,sem_CExpr_1) }) }) })+sem_CExpr_TupUpd :: T_CExpr ->+ CTag ->+ HsName ->+ T_CExpr ->+ T_CExpr ->+ T_CExpr+sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ =+ (case (ExprIsOther) of+ { _whatBelow ->+ (case (_whatBelow) of+ { _lhsOwhatBelow ->+ (case ((let sem_CExpr_TupUpd_1 :: T_CExpr_1+ sem_CExpr_TupUpd_1 =+ (\ _lhsIlev+ _lhsIrefOffset+ _lhsIwhatAbove ->+ (case (ExprIsOther) of+ { _whatAbove ->+ (case (_whatAbove) of+ { _fldExprOwhatAbove ->+ (case (_lhsIrefOffset) of+ { _exprOrefOffset ->+ (case (expr_) of+ { ( _exprIwhatBelow,expr_1) ->+ (case (_whatAbove) of+ { _exprOwhatAbove ->+ (case (_lhsIlev) of+ { _exprOlev ->+ (case (expr_1 _exprOlev _exprOrefOffset _exprOwhatAbove) of+ { ( _exprInm2refGath,_exprIrefOffset,expr_2) ->+ (case (_exprIrefOffset) of+ { _offsetOrefOffset ->+ (case (offset_) of+ { ( _offsetIwhatBelow,offset_1) ->+ (case (_whatAbove) of+ { _offsetOwhatAbove ->+ (case (_lhsIlev) of+ { _offsetOlev ->+ (case (offset_1 _offsetOlev _offsetOrefOffset _offsetOwhatAbove) of+ { ( _offsetInm2refGath,_offsetIrefOffset,offset_2) ->+ (case (_offsetIrefOffset) of+ { _fldExprOrefOffset ->+ (case (_lhsIlev) of+ { _fldExprOlev ->+ (case (fldExpr_) of+ { ( _fldExprIwhatBelow,fldExpr_1) ->+ (case (fldExpr_1 _fldExprOlev _fldExprOrefOffset _fldExprOwhatAbove) of+ { ( _fldExprInm2refGath,_fldExprIrefOffset,fldExpr_2) ->+ (case (_exprInm2refGath `CR.nm2refUnion` _offsetInm2refGath `CR.nm2refUnion` _fldExprInm2refGath) of+ { _lhsOnm2refGath ->+ (case (_fldExprIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CExpr_TupUpd_2 :: T_CExpr_2+ sem_CExpr_TupUpd_2 =+ (\ _lhsIevalCtx+ _lhsIimpNmLkup+ _lhsIisTopApp+ _lhsIisTopTup+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth+ _lhsItailCtx ->+ (case (AppFunKind_NoApp) of+ { _lhsOappFunKind ->+ (case ([]) of+ { _lhsOcrb ->+ (case (CR.dbg "Core.ToCoreRun.CExpr.cre") of+ { _creBase ->+ (case (cseCtxWrap _lhsItailCtx _creBase) of+ { _cre ->+ (case (_cre) of+ { _lhsOcre ->+ (case ([]) of+ { _creAppArgL ->+ (case (_creAppArgL) of+ { _lhsOcreAppArgL ->+ (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of+ { _creAppFun ->+ (case (_creAppFun) of+ { _lhsOcreAppFun ->+ (case ([]) of+ { _creLamArgL ->+ (case (_creLamArgL) of+ { _lhsOcreLamArgL ->+ (case (_cre) of+ { _creLamBody ->+ (case (_creLamBody) of+ { _lhsOcreLamBody ->+ (case (panic "Core.ToCoreRun.CExpr.crse") of+ { _crse ->+ (case (_crse) of+ { _lhsOcrse ->+ (case (Nothing) of+ { _lhsOmbFFIApp ->+ (case (Nothing) of+ { _lhsOmbLam ->+ (case (Nothing) of+ { _lhsOmbVar ->+ (case (_lhsItailCtx) of+ { _fldExprOtailCtx ->+ (case (_lhsIstackDepth) of+ { _exprOstackDepth ->+ (case (_lhsItailCtx) of+ { _exprOtailCtx ->+ (case (_lhsIopts) of+ { _exprOopts ->+ (case (_lhsInm2ref) of+ { _exprOnm2ref ->+ (case (_lhsImodNr) of+ { _exprOmodNr ->+ (case (True) of+ { _isTopApp ->+ (case (_isTopApp) of+ { _exprOisTopApp ->+ (case (_lhsIimpNmLkup) of+ { _exprOimpNmLkup ->+ (case (_lhsIevalCtx) of+ { _exprOevalCtx ->+ (case (False) of+ { _exprOisTopTup ->+ (case (expr_2 _exprOevalCtx _exprOimpNmLkup _exprOisTopApp _exprOisTopTup _exprOmodNr _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of+ { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax,_exprIvref) ->+ (case (_exprIstackDepth) of+ { _offsetOstackDepth ->+ (case (_lhsItailCtx) of+ { _offsetOtailCtx ->+ (case (_lhsIopts) of+ { _offsetOopts ->+ (case (_lhsInm2ref) of+ { _offsetOnm2ref ->+ (case (_lhsImodNr) of+ { _offsetOmodNr ->+ (case (True) of+ { _isTopTup ->+ (case (_isTopTup) of+ { _offsetOisTopTup ->+ (case (_isTopApp) of+ { _offsetOisTopApp ->+ (case (_lhsIimpNmLkup) of+ { _offsetOimpNmLkup ->+ (case (_lhsIevalCtx) of+ { _offsetOevalCtx ->+ (case (offset_2 _offsetOevalCtx _offsetOimpNmLkup _offsetOisTopApp _offsetOisTopTup _offsetOmodNr _offsetOnm2ref _offsetOopts _offsetOstackDepth _offsetOtailCtx) of+ { ( _offsetIappFunKind,_offsetIcrb,_offsetIcre,_offsetIcreAppArgL,_offsetIcreAppFun,_offsetIcreLamArgL,_offsetIcreLamBody,_offsetIcrse,_offsetImbFFIApp,_offsetImbLam,_offsetImbVar,_offsetIrefOffsetMax,_offsetIstackDepth,_offsetIstackDepthMax,_offsetIvref) ->+ (case (_offsetIstackDepth) of+ { _fldExprOstackDepth ->+ (case (_lhsIopts) of+ { _fldExprOopts ->+ (case (_lhsInm2ref) of+ { _fldExprOnm2ref ->+ (case (_lhsImodNr) of+ { _fldExprOmodNr ->+ (case (_isTopTup) of+ { _fldExprOisTopTup ->+ (case (_isTopApp) of+ { _fldExprOisTopApp ->+ (case (_lhsIimpNmLkup) of+ { _fldExprOimpNmLkup ->+ (case (_lhsIevalCtx) of+ { _fldExprOevalCtx ->+ (case (fldExpr_2 _fldExprOevalCtx _fldExprOimpNmLkup _fldExprOisTopApp _fldExprOisTopTup _fldExprOmodNr _fldExprOnm2ref _fldExprOopts _fldExprOstackDepth _fldExprOtailCtx) of+ { ( _fldExprIappFunKind,_fldExprIcrb,_fldExprIcre,_fldExprIcreAppArgL,_fldExprIcreAppFun,_fldExprIcreLamArgL,_fldExprIcreLamBody,_fldExprIcrse,_fldExprImbFFIApp,_fldExprImbLam,_fldExprImbVar,_fldExprIrefOffsetMax,_fldExprIstackDepth,_fldExprIstackDepthMax,_fldExprIvref) ->+ (case (_exprIrefOffsetMax `max` _offsetIrefOffsetMax `max` _fldExprIrefOffsetMax) of+ { _lhsOrefOffsetMax ->+ (case (_lhsIstackDepth + 1) of+ { _stackDepthHere ->+ (case (_stackDepthHere) of+ { _lhsOstackDepth ->+ (case (_stackDepthHere) of+ { _lhsOstackDepthMax ->+ (case (panic "Core.ToCoreRun.CExpr.ref") of+ { _vref ->+ (case (_vref) of+ { _lhsOvref ->+ ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_TupUpd_2)) of+ { ( sem_CExpr_2) ->+ ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_TupUpd_1)) of+ { ( sem_CExpr_1) ->+ ( _lhsOwhatBelow,sem_CExpr_1) }) }) })+sem_CExpr_FFI :: FFIWay ->+ String ->+ ForeignEnt ->+ Ty ->+ T_CExpr+sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ =+ (case (ExprIsFFI) of+ { _whatBelow ->+ (case (_whatBelow) of+ { _lhsOwhatBelow ->+ (case ((let sem_CExpr_FFI_1 :: T_CExpr_1+ sem_CExpr_FFI_1 =+ (\ _lhsIlev+ _lhsIrefOffset+ _lhsIwhatAbove ->+ (case (CR.emptyNm2RefMp) of+ { _lhsOnm2refGath ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CExpr_FFI_2 :: T_CExpr_2+ sem_CExpr_FFI_2 =+ (\ _lhsIevalCtx+ _lhsIimpNmLkup+ _lhsIisTopApp+ _lhsIisTopTup+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth+ _lhsItailCtx ->+ (case (AppFunKind_FFI) of+ { _lhsOappFunKind ->+ (case ([]) of+ { _lhsOcrb ->+ (case (foreignEntExtract impEnt_) of+ { _foreignEntInfo ->+ (case (forextractMbEnt _foreignEntInfo) of+ { _creEntMb ->+ (case (\as -> maybe (CR.dbg $ "Core.ToCoreRun.CExpr.FFI.cre: " ++ show _foreignEntInfo) (\ent -> CR.mkFFI' ent as) _creEntMb) of+ { _creMk ->+ (case (_creMk CR.emptyCRArray) of+ { _creBase ->+ (case (_creBase) of+ { _cre ->+ (case (_cre) of+ { _lhsOcre ->+ (case ([]) of+ { _creAppArgL ->+ (case (_creAppArgL) of+ { _lhsOcreAppArgL ->+ (case (\_ -> cseCtxWrap TailCtx_Plain . _creMk) of+ { _creAppFun ->+ (case (_creAppFun) of+ { _lhsOcreAppFun ->+ (case ([]) of+ { _creLamArgL ->+ (case (_creLamArgL) of+ { _lhsOcreLamArgL ->+ (case (_cre) of+ { _creLamBody ->+ (case (_creLamBody) of+ { _lhsOcreLamBody ->+ (case (panic "Core.ToCoreRun.CExpr.crse") of+ { _crse ->+ (case (_crse) of+ { _lhsOcrse ->+ (case (maybe Nothing lookupPrimNeedsEval $ forextractMbEnt _foreignEntInfo) of+ { _mbPrimNeedEval ->+ (case (maybe False primResNeedEval _mbPrimNeedEval) of+ { _primResNeedsEval ->+ (case (appUnArr ty_) of+ { _argTyLresTy ->+ (case (snd _argTyLresTy) of+ { _resTy ->+ (case (fst _argTyLresTy) of+ { _argTyL ->+ (case (Just ( _resTy+ , _primResNeedsEval+ , callconv_+ , impEnt_+ , _argTyL+ )) of+ { _lhsOmbFFIApp ->+ (case (Nothing) of+ { _lhsOmbLam ->+ (case (Nothing) of+ { _lhsOmbVar ->+ (case (0) of+ { _lhsOrefOffsetMax ->+ (case (_lhsIstackDepth + 1) of+ { _stackDepthHere ->+ (case (_stackDepthHere) of+ { _lhsOstackDepth ->+ (case (_stackDepthHere) of+ { _lhsOstackDepthMax ->+ (case (panic "Core.ToCoreRun.CExpr.ref") of+ { _vref ->+ (case (_vref) of+ { _lhsOvref ->+ ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_FFI_2)) of+ { ( sem_CExpr_2) ->+ ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }))+ in sem_CExpr_FFI_1)) of+ { ( sem_CExpr_1) ->+ ( _lhsOwhatBelow,sem_CExpr_1) }) }) })+sem_CExpr_Dbg :: String ->+ T_CExpr+sem_CExpr_Dbg info_ =+ (case (ExprIsOther) of+ { _whatBelow ->+ (case (_whatBelow) of+ { _lhsOwhatBelow ->+ (case ((let sem_CExpr_Dbg_1 :: T_CExpr_1+ sem_CExpr_Dbg_1 =+ (\ _lhsIlev+ _lhsIrefOffset+ _lhsIwhatAbove ->+ (case (CR.emptyNm2RefMp) of+ { _lhsOnm2refGath ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CExpr_Dbg_2 :: T_CExpr_2+ sem_CExpr_Dbg_2 =+ (\ _lhsIevalCtx+ _lhsIimpNmLkup+ _lhsIisTopApp+ _lhsIisTopTup+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth+ _lhsItailCtx ->+ (case (AppFunKind_NoApp) of+ { _lhsOappFunKind ->+ (case ([]) of+ { _lhsOcrb ->+ (case (CR.dbg "Core.ToCoreRun.CExpr.cre") of+ { _creBase ->+ (case (cseCtxWrap _lhsItailCtx _creBase) of+ { _cre ->+ (case (_cre) of+ { _lhsOcre ->+ (case ([]) of+ { _creAppArgL ->+ (case (_creAppArgL) of+ { _lhsOcreAppArgL ->+ (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of+ { _creAppFun ->+ (case (_creAppFun) of+ { _lhsOcreAppFun ->+ (case ([]) of+ { _creLamArgL ->+ (case (_creLamArgL) of+ { _lhsOcreLamArgL ->+ (case (_cre) of+ { _creLamBody ->+ (case (_creLamBody) of+ { _lhsOcreLamBody ->+ (case (panic "Core.ToCoreRun.CExpr.crse") of+ { _crse ->+ (case (_crse) of+ { _lhsOcrse ->+ (case (Nothing) of+ { _lhsOmbFFIApp ->+ (case (Nothing) of+ { _lhsOmbLam ->+ (case (Nothing) of+ { _lhsOmbVar ->+ (case (0) of+ { _lhsOrefOffsetMax ->+ (case (_lhsIstackDepth + 1) of+ { _stackDepthHere ->+ (case (_stackDepthHere) of+ { _lhsOstackDepth ->+ (case (_stackDepthHere) of+ { _lhsOstackDepthMax ->+ (case (panic "Core.ToCoreRun.CExpr.ref") of+ { _vref ->+ (case (_vref) of+ { _lhsOvref ->+ ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_Dbg_2)) of+ { ( sem_CExpr_2) ->+ ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }))+ in sem_CExpr_Dbg_1)) of+ { ( sem_CExpr_1) ->+ ( _lhsOwhatBelow,sem_CExpr_1) }) }) })+sem_CExpr_Hole :: UID ->+ T_CExpr+sem_CExpr_Hole uid_ =+ (case (ExprIsOther) of+ { _whatBelow ->+ (case (_whatBelow) of+ { _lhsOwhatBelow ->+ (case ((let sem_CExpr_Hole_1 :: T_CExpr_1+ sem_CExpr_Hole_1 =+ (\ _lhsIlev+ _lhsIrefOffset+ _lhsIwhatAbove ->+ (case (CR.emptyNm2RefMp) of+ { _lhsOnm2refGath ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CExpr_Hole_2 :: T_CExpr_2+ sem_CExpr_Hole_2 =+ (\ _lhsIevalCtx+ _lhsIimpNmLkup+ _lhsIisTopApp+ _lhsIisTopTup+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth+ _lhsItailCtx ->+ (case (AppFunKind_NoApp) of+ { _lhsOappFunKind ->+ (case ([]) of+ { _lhsOcrb ->+ (case (CR.dbg "Core.ToCoreRun.CExpr.cre") of+ { _creBase ->+ (case (cseCtxWrap _lhsItailCtx _creBase) of+ { _cre ->+ (case (_cre) of+ { _lhsOcre ->+ (case ([]) of+ { _creAppArgL ->+ (case (_creAppArgL) of+ { _lhsOcreAppArgL ->+ (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of+ { _creAppFun ->+ (case (_creAppFun) of+ { _lhsOcreAppFun ->+ (case ([]) of+ { _creLamArgL ->+ (case (_creLamArgL) of+ { _lhsOcreLamArgL ->+ (case (_cre) of+ { _creLamBody ->+ (case (_creLamBody) of+ { _lhsOcreLamBody ->+ (case (panic "Core.ToCoreRun.CExpr.crse") of+ { _crse ->+ (case (_crse) of+ { _lhsOcrse ->+ (case (Nothing) of+ { _lhsOmbFFIApp ->+ (case (Nothing) of+ { _lhsOmbLam ->+ (case (Nothing) of+ { _lhsOmbVar ->+ (case (0) of+ { _lhsOrefOffsetMax ->+ (case (_lhsIstackDepth + 1) of+ { _stackDepthHere ->+ (case (_stackDepthHere) of+ { _lhsOstackDepth ->+ (case (_stackDepthHere) of+ { _lhsOstackDepthMax ->+ (case (panic "Core.ToCoreRun.CExpr.ref") of+ { _vref ->+ (case (_vref) of+ { _lhsOvref ->+ ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_Hole_2)) of+ { ( sem_CExpr_2) ->+ ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }))+ in sem_CExpr_Hole_1)) of+ { ( sem_CExpr_1) ->+ ( _lhsOwhatBelow,sem_CExpr_1) }) }) })+sem_CExpr_HoleLet :: UID ->+ T_CExpr ->+ T_CExpr+sem_CExpr_HoleLet bindsUid_ body_ =+ (case (ExprIsOther) of+ { _whatBelow ->+ (case (_whatBelow) of+ { _lhsOwhatBelow ->+ (case ((let sem_CExpr_HoleLet_1 :: T_CExpr_1+ sem_CExpr_HoleLet_1 =+ (\ _lhsIlev+ _lhsIrefOffset+ _lhsIwhatAbove ->+ (case (ExprIsOther) of+ { _whatAbove ->+ (case (_whatAbove) of+ { _bodyOwhatAbove ->+ (case (_lhsIrefOffset) of+ { _bodyOrefOffset ->+ (case (_lhsIlev) of+ { _bodyOlev ->+ (case (body_) of+ { ( _bodyIwhatBelow,body_1) ->+ (case (body_1 _bodyOlev _bodyOrefOffset _bodyOwhatAbove) of+ { ( _bodyInm2refGath,_bodyIrefOffset,body_2) ->+ (case (_bodyInm2refGath) of+ { _lhsOnm2refGath ->+ (case (_bodyIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CExpr_HoleLet_2 :: T_CExpr_2+ sem_CExpr_HoleLet_2 =+ (\ _lhsIevalCtx+ _lhsIimpNmLkup+ _lhsIisTopApp+ _lhsIisTopTup+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth+ _lhsItailCtx ->+ (case (AppFunKind_NoApp) of+ { _lhsOappFunKind ->+ (case ([]) of+ { _lhsOcrb ->+ (case (CR.dbg "Core.ToCoreRun.CExpr.cre") of+ { _creBase ->+ (case (cseCtxWrap _lhsItailCtx _creBase) of+ { _cre ->+ (case (_cre) of+ { _lhsOcre ->+ (case ([]) of+ { _creAppArgL ->+ (case (_creAppArgL) of+ { _lhsOcreAppArgL ->+ (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of+ { _creAppFun ->+ (case (_creAppFun) of+ { _lhsOcreAppFun ->+ (case ([]) of+ { _creLamArgL ->+ (case (_creLamArgL) of+ { _lhsOcreLamArgL ->+ (case (_cre) of+ { _creLamBody ->+ (case (_creLamBody) of+ { _lhsOcreLamBody ->+ (case (panic "Core.ToCoreRun.CExpr.crse") of+ { _crse ->+ (case (_crse) of+ { _lhsOcrse ->+ (case (Nothing) of+ { _lhsOmbFFIApp ->+ (case (Nothing) of+ { _lhsOmbLam ->+ (case (Nothing) of+ { _lhsOmbVar ->+ (case (_lhsItailCtx) of+ { _bodyOtailCtx ->+ (case (_lhsIstackDepth) of+ { _bodyOstackDepth ->+ (case (_lhsIopts) of+ { _bodyOopts ->+ (case (_lhsInm2ref) of+ { _bodyOnm2ref ->+ (case (_lhsImodNr) of+ { _bodyOmodNr ->+ (case (True) of+ { _isTopTup ->+ (case (_isTopTup) of+ { _bodyOisTopTup ->+ (case (True) of+ { _isTopApp ->+ (case (_isTopApp) of+ { _bodyOisTopApp ->+ (case (_lhsIimpNmLkup) of+ { _bodyOimpNmLkup ->+ (case (_lhsIevalCtx) of+ { _bodyOevalCtx ->+ (case (body_2 _bodyOevalCtx _bodyOimpNmLkup _bodyOisTopApp _bodyOisTopTup _bodyOmodNr _bodyOnm2ref _bodyOopts _bodyOstackDepth _bodyOtailCtx) of+ { ( _bodyIappFunKind,_bodyIcrb,_bodyIcre,_bodyIcreAppArgL,_bodyIcreAppFun,_bodyIcreLamArgL,_bodyIcreLamBody,_bodyIcrse,_bodyImbFFIApp,_bodyImbLam,_bodyImbVar,_bodyIrefOffsetMax,_bodyIstackDepth,_bodyIstackDepthMax,_bodyIvref) ->+ (case (_bodyIrefOffsetMax) of+ { _lhsOrefOffsetMax ->+ (case (_lhsIstackDepth + 1) of+ { _stackDepthHere ->+ (case (_stackDepthHere) of+ { _lhsOstackDepth ->+ (case (_stackDepthHere) of+ { _lhsOstackDepthMax ->+ (case (panic "Core.ToCoreRun.CExpr.ref") of+ { _vref ->+ (case (_vref) of+ { _lhsOvref ->+ ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_HoleLet_2)) of+ { ( sem_CExpr_2) ->+ ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_HoleLet_1)) of+ { ( sem_CExpr_1) ->+ ( _lhsOwhatBelow,sem_CExpr_1) }) }) })+sem_CExpr_CoeArg :: T_CExpr+sem_CExpr_CoeArg =+ (case (ExprIsOther) of+ { _whatBelow ->+ (case (_whatBelow) of+ { _lhsOwhatBelow ->+ (case ((let sem_CExpr_CoeArg_1 :: T_CExpr_1+ sem_CExpr_CoeArg_1 =+ (\ _lhsIlev+ _lhsIrefOffset+ _lhsIwhatAbove ->+ (case (CR.emptyNm2RefMp) of+ { _lhsOnm2refGath ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CExpr_CoeArg_2 :: T_CExpr_2+ sem_CExpr_CoeArg_2 =+ (\ _lhsIevalCtx+ _lhsIimpNmLkup+ _lhsIisTopApp+ _lhsIisTopTup+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth+ _lhsItailCtx ->+ (case (AppFunKind_NoApp) of+ { _lhsOappFunKind ->+ (case ([]) of+ { _lhsOcrb ->+ (case (CR.dbg "Core.ToCoreRun.CExpr.cre") of+ { _creBase ->+ (case (cseCtxWrap _lhsItailCtx _creBase) of+ { _cre ->+ (case (_cre) of+ { _lhsOcre ->+ (case ([]) of+ { _creAppArgL ->+ (case (_creAppArgL) of+ { _lhsOcreAppArgL ->+ (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of+ { _creAppFun ->+ (case (_creAppFun) of+ { _lhsOcreAppFun ->+ (case ([]) of+ { _creLamArgL ->+ (case (_creLamArgL) of+ { _lhsOcreLamArgL ->+ (case (_cre) of+ { _creLamBody ->+ (case (_creLamBody) of+ { _lhsOcreLamBody ->+ (case (panic "Core.ToCoreRun.CExpr.crse") of+ { _crse ->+ (case (_crse) of+ { _lhsOcrse ->+ (case (Nothing) of+ { _lhsOmbFFIApp ->+ (case (Nothing) of+ { _lhsOmbLam ->+ (case (Nothing) of+ { _lhsOmbVar ->+ (case (0) of+ { _lhsOrefOffsetMax ->+ (case (_lhsIstackDepth + 1) of+ { _stackDepthHere ->+ (case (_stackDepthHere) of+ { _lhsOstackDepth ->+ (case (_stackDepthHere) of+ { _lhsOstackDepthMax ->+ (case (panic "Core.ToCoreRun.CExpr.ref") of+ { _vref ->+ (case (_vref) of+ { _lhsOvref ->+ ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_CoeArg_2)) of+ { ( sem_CExpr_2) ->+ ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }))+ in sem_CExpr_CoeArg_1)) of+ { ( sem_CExpr_1) ->+ ( _lhsOwhatBelow,sem_CExpr_1) }) }) })+sem_CExpr_ImplsApp :: T_CExpr ->+ ImplsVarId ->+ T_CExpr+sem_CExpr_ImplsApp func_ uid_ =+ (case (ExprIsOther) of+ { _whatBelow ->+ (case (_whatBelow) of+ { _lhsOwhatBelow ->+ (case ((let sem_CExpr_ImplsApp_1 :: T_CExpr_1+ sem_CExpr_ImplsApp_1 =+ (\ _lhsIlev+ _lhsIrefOffset+ _lhsIwhatAbove ->+ (case (ExprIsOther) of+ { _whatAbove ->+ (case (_whatAbove) of+ { _funcOwhatAbove ->+ (case (_lhsIrefOffset) of+ { _funcOrefOffset ->+ (case (_lhsIlev) of+ { _funcOlev ->+ (case (func_) of+ { ( _funcIwhatBelow,func_1) ->+ (case (func_1 _funcOlev _funcOrefOffset _funcOwhatAbove) of+ { ( _funcInm2refGath,_funcIrefOffset,func_2) ->+ (case (_funcInm2refGath) of+ { _lhsOnm2refGath ->+ (case (_funcIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CExpr_ImplsApp_2 :: T_CExpr_2+ sem_CExpr_ImplsApp_2 =+ (\ _lhsIevalCtx+ _lhsIimpNmLkup+ _lhsIisTopApp+ _lhsIisTopTup+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth+ _lhsItailCtx ->+ (case (AppFunKind_NoApp) of+ { _lhsOappFunKind ->+ (case ([]) of+ { _lhsOcrb ->+ (case (CR.dbg "Core.ToCoreRun.CExpr.cre") of+ { _creBase ->+ (case (cseCtxWrap _lhsItailCtx _creBase) of+ { _cre ->+ (case (_cre) of+ { _lhsOcre ->+ (case ([]) of+ { _creAppArgL ->+ (case (_creAppArgL) of+ { _lhsOcreAppArgL ->+ (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of+ { _creAppFun ->+ (case (_creAppFun) of+ { _lhsOcreAppFun ->+ (case ([]) of+ { _creLamArgL ->+ (case (_creLamArgL) of+ { _lhsOcreLamArgL ->+ (case (_cre) of+ { _creLamBody ->+ (case (_creLamBody) of+ { _lhsOcreLamBody ->+ (case (panic "Core.ToCoreRun.CExpr.crse") of+ { _crse ->+ (case (_crse) of+ { _lhsOcrse ->+ (case (Nothing) of+ { _lhsOmbFFIApp ->+ (case (Nothing) of+ { _lhsOmbLam ->+ (case (Nothing) of+ { _lhsOmbVar ->+ (case (_lhsItailCtx) of+ { _funcOtailCtx ->+ (case (_lhsIstackDepth) of+ { _funcOstackDepth ->+ (case (_lhsIopts) of+ { _funcOopts ->+ (case (_lhsInm2ref) of+ { _funcOnm2ref ->+ (case (_lhsImodNr) of+ { _funcOmodNr ->+ (case (True) of+ { _isTopTup ->+ (case (_isTopTup) of+ { _funcOisTopTup ->+ (case (True) of+ { _isTopApp ->+ (case (_isTopApp) of+ { _funcOisTopApp ->+ (case (_lhsIimpNmLkup) of+ { _funcOimpNmLkup ->+ (case (_lhsIevalCtx) of+ { _funcOevalCtx ->+ (case (func_2 _funcOevalCtx _funcOimpNmLkup _funcOisTopApp _funcOisTopTup _funcOmodNr _funcOnm2ref _funcOopts _funcOstackDepth _funcOtailCtx) of+ { ( _funcIappFunKind,_funcIcrb,_funcIcre,_funcIcreAppArgL,_funcIcreAppFun,_funcIcreLamArgL,_funcIcreLamBody,_funcIcrse,_funcImbFFIApp,_funcImbLam,_funcImbVar,_funcIrefOffsetMax,_funcIstackDepth,_funcIstackDepthMax,_funcIvref) ->+ (case (_funcIrefOffsetMax) of+ { _lhsOrefOffsetMax ->+ (case (_lhsIstackDepth + 1) of+ { _stackDepthHere ->+ (case (_stackDepthHere) of+ { _lhsOstackDepth ->+ (case (_stackDepthHere) of+ { _lhsOstackDepthMax ->+ (case (panic "Core.ToCoreRun.CExpr.ref") of+ { _vref ->+ (case (_vref) of+ { _lhsOvref ->+ ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_ImplsApp_2)) of+ { ( sem_CExpr_2) ->+ ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_ImplsApp_1)) of+ { ( sem_CExpr_1) ->+ ( _lhsOwhatBelow,sem_CExpr_1) }) }) })+sem_CExpr_ImplsLam :: ImplsVarId ->+ T_CExpr ->+ T_CExpr+sem_CExpr_ImplsLam uid_ body_ =+ (case (ExprIsOther) of+ { _whatBelow ->+ (case (_whatBelow) of+ { _lhsOwhatBelow ->+ (case ((let sem_CExpr_ImplsLam_1 :: T_CExpr_1+ sem_CExpr_ImplsLam_1 =+ (\ _lhsIlev+ _lhsIrefOffset+ _lhsIwhatAbove ->+ (case (ExprIsOther) of+ { _whatAbove ->+ (case (_whatAbove) of+ { _bodyOwhatAbove ->+ (case (_lhsIrefOffset) of+ { _bodyOrefOffset ->+ (case (_lhsIlev) of+ { _bodyOlev ->+ (case (body_) of+ { ( _bodyIwhatBelow,body_1) ->+ (case (body_1 _bodyOlev _bodyOrefOffset _bodyOwhatAbove) of+ { ( _bodyInm2refGath,_bodyIrefOffset,body_2) ->+ (case (_bodyInm2refGath) of+ { _lhsOnm2refGath ->+ (case (_bodyIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CExpr_ImplsLam_2 :: T_CExpr_2+ sem_CExpr_ImplsLam_2 =+ (\ _lhsIevalCtx+ _lhsIimpNmLkup+ _lhsIisTopApp+ _lhsIisTopTup+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth+ _lhsItailCtx ->+ (case (AppFunKind_NoApp) of+ { _lhsOappFunKind ->+ (case ([]) of+ { _lhsOcrb ->+ (case (CR.dbg "Core.ToCoreRun.CExpr.cre") of+ { _creBase ->+ (case (cseCtxWrap _lhsItailCtx _creBase) of+ { _cre ->+ (case (_cre) of+ { _lhsOcre ->+ (case ([]) of+ { _creAppArgL ->+ (case (_creAppArgL) of+ { _lhsOcreAppArgL ->+ (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of+ { _creAppFun ->+ (case (_creAppFun) of+ { _lhsOcreAppFun ->+ (case ([]) of+ { _creLamArgL ->+ (case (_creLamArgL) of+ { _lhsOcreLamArgL ->+ (case (_cre) of+ { _creLamBody ->+ (case (_creLamBody) of+ { _lhsOcreLamBody ->+ (case (panic "Core.ToCoreRun.CExpr.crse") of+ { _crse ->+ (case (_crse) of+ { _lhsOcrse ->+ (case (Nothing) of+ { _lhsOmbFFIApp ->+ (case (Nothing) of+ { _lhsOmbLam ->+ (case (Nothing) of+ { _lhsOmbVar ->+ (case (_lhsItailCtx) of+ { _bodyOtailCtx ->+ (case (_lhsIstackDepth) of+ { _bodyOstackDepth ->+ (case (_lhsIopts) of+ { _bodyOopts ->+ (case (_lhsInm2ref) of+ { _bodyOnm2ref ->+ (case (_lhsImodNr) of+ { _bodyOmodNr ->+ (case (True) of+ { _isTopTup ->+ (case (_isTopTup) of+ { _bodyOisTopTup ->+ (case (True) of+ { _isTopApp ->+ (case (_isTopApp) of+ { _bodyOisTopApp ->+ (case (_lhsIimpNmLkup) of+ { _bodyOimpNmLkup ->+ (case (_lhsIevalCtx) of+ { _bodyOevalCtx ->+ (case (body_2 _bodyOevalCtx _bodyOimpNmLkup _bodyOisTopApp _bodyOisTopTup _bodyOmodNr _bodyOnm2ref _bodyOopts _bodyOstackDepth _bodyOtailCtx) of+ { ( _bodyIappFunKind,_bodyIcrb,_bodyIcre,_bodyIcreAppArgL,_bodyIcreAppFun,_bodyIcreLamArgL,_bodyIcreLamBody,_bodyIcrse,_bodyImbFFIApp,_bodyImbLam,_bodyImbVar,_bodyIrefOffsetMax,_bodyIstackDepth,_bodyIstackDepthMax,_bodyIvref) ->+ (case (_bodyIrefOffsetMax) of+ { _lhsOrefOffsetMax ->+ (case (_lhsIstackDepth + 1) of+ { _stackDepthHere ->+ (case (_stackDepthHere) of+ { _lhsOstackDepth ->+ (case (_stackDepthHere) of+ { _lhsOstackDepthMax ->+ (case (panic "Core.ToCoreRun.CExpr.ref") of+ { _vref ->+ (case (_vref) of+ { _lhsOvref ->+ ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_ImplsLam_2)) of+ { ( sem_CExpr_2) ->+ ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_ImplsLam_1)) of+ { ( sem_CExpr_1) ->+ ( _lhsOwhatBelow,sem_CExpr_1) }) }) })+sem_CExpr_Ann :: T_CExprAnn ->+ T_CExpr ->+ T_CExpr+sem_CExpr_Ann ann_ expr_ =+ (case (expr_) of+ { ( _exprIwhatBelow,expr_1) ->+ (case (_exprIwhatBelow) of+ { _lhsOwhatBelow ->+ (case ((let sem_CExpr_Ann_1 :: T_CExpr_1+ sem_CExpr_Ann_1 =+ (\ _lhsIlev+ _lhsIrefOffset+ _lhsIwhatAbove ->+ (case (_lhsIwhatAbove) of+ { _exprOwhatAbove ->+ (case (_lhsIrefOffset) of+ { _annOrefOffset ->+ (case (ann_ _annOrefOffset) of+ { ( _annIrefOffset,ann_1) ->+ (case (_annIrefOffset) of+ { _exprOrefOffset ->+ (case (_lhsIlev) of+ { _exprOlev ->+ (case (expr_1 _exprOlev _exprOrefOffset _exprOwhatAbove) of+ { ( _exprInm2refGath,_exprIrefOffset,expr_2) ->+ (case (_exprInm2refGath) of+ { _lhsOnm2refGath ->+ (case (_exprIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CExpr_Ann_2 :: T_CExpr_2+ sem_CExpr_Ann_2 =+ (\ _lhsIevalCtx+ _lhsIimpNmLkup+ _lhsIisTopApp+ _lhsIisTopTup+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth+ _lhsItailCtx ->+ (case (_lhsItailCtx) of+ { _exprOtailCtx ->+ (case (_lhsIstackDepth) of+ { _annOstackDepth ->+ (case (_lhsIopts) of+ { _annOopts ->+ (case (_lhsInm2ref) of+ { _annOnm2ref ->+ (case (_lhsImodNr) of+ { _annOmodNr ->+ (case (_lhsIlev) of+ { _annOlev ->+ (case (_lhsIimpNmLkup) of+ { _annOimpNmLkup ->+ (case (ann_1 _annOimpNmLkup _annOlev _annOmodNr _annOnm2ref _annOopts _annOstackDepth) of+ { ( _annIstackDepth) ->+ (case (_annIstackDepth) of+ { _exprOstackDepth ->+ (case (_lhsIopts) of+ { _exprOopts ->+ (case (_lhsInm2ref) of+ { _exprOnm2ref ->+ (case (_lhsImodNr) of+ { _exprOmodNr ->+ (case (_lhsIisTopTup) of+ { _exprOisTopTup ->+ (case (_lhsIisTopApp) of+ { _exprOisTopApp ->+ (case (_lhsIimpNmLkup) of+ { _exprOimpNmLkup ->+ (case (_lhsIevalCtx) of+ { _exprOevalCtx ->+ (case (expr_2 _exprOevalCtx _exprOimpNmLkup _exprOisTopApp _exprOisTopTup _exprOmodNr _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of+ { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax,_exprIvref) ->+ (case (_exprIappFunKind) of+ { _lhsOappFunKind ->+ (case (_exprIcrb) of+ { _lhsOcrb ->+ (case (_exprIcre) of+ { _lhsOcre ->+ (case (_exprIcreAppArgL) of+ { _lhsOcreAppArgL ->+ (case (_exprIcreAppFun) of+ { _lhsOcreAppFun ->+ (case (_exprIcreLamArgL) of+ { _lhsOcreLamArgL ->+ (case (_exprIcreLamBody) of+ { _lhsOcreLamBody ->+ (case (panic "Core.ToCoreRun.CExpr.crse") of+ { _crse ->+ (case (_crse) of+ { _lhsOcrse ->+ (case (_exprImbFFIApp) of+ { _lhsOmbFFIApp ->+ (case (_exprImbLam) of+ { _lhsOmbLam ->+ (case (_exprImbVar) of+ { _lhsOmbVar ->+ (case (_exprIrefOffsetMax) of+ { _lhsOrefOffsetMax ->+ (case (_exprIstackDepth) of+ { _lhsOstackDepth ->+ (case (_exprIstackDepthMax) of+ { _lhsOstackDepthMax ->+ (case (panic "Core.ToCoreRun.CExpr.ref") of+ { _vref ->+ (case (_vref) of+ { _lhsOvref ->+ ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax,_lhsOvref) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_Ann_2)) of+ { ( sem_CExpr_2) ->+ ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }))+ in sem_CExpr_Ann_1)) of+ { ( sem_CExpr_1) ->+ ( _lhsOwhatBelow,sem_CExpr_1) }) }) })+-- CExprAnn ----------------------------------------------------+{-+ visit 0:+ chained attribute:+ refOffset : Int+ visit 1:+ inherited attributes:+ impNmLkup : HsName -> Maybe Int+ lev : Int+ modNr : Int+ nm2ref : CR.Nm2RefMp+ opts : EHCOpts+ chained attribute:+ stackDepth : Int+ alternatives:+ alternative Ty:+ child ty : {Ty}+ alternative Coe:+ child coe : {RelevCoe}+ alternative Debug:+ child info : {String}+-}+-- cata+sem_CExprAnn :: CExprAnn ->+ T_CExprAnn+sem_CExprAnn (CExprAnn_Ty _ty) =+ (sem_CExprAnn_Ty _ty)+sem_CExprAnn (CExprAnn_Coe _coe) =+ (sem_CExprAnn_Coe _coe)+sem_CExprAnn (CExprAnn_Debug _info) =+ (sem_CExprAnn_Debug _info)+-- semantic domain+type T_CExprAnn = Int ->+ ( Int,T_CExprAnn_1)+type T_CExprAnn_1 = (HsName -> Maybe Int) ->+ Int ->+ Int ->+ (CR.Nm2RefMp) ->+ EHCOpts ->+ Int ->+ ( Int)+sem_CExprAnn_Ty :: Ty ->+ T_CExprAnn+sem_CExprAnn_Ty ty_ =+ (\ _lhsIrefOffset ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CExprAnn_Ty_1 :: T_CExprAnn_1+ sem_CExprAnn_Ty_1 =+ (\ _lhsIimpNmLkup+ _lhsIlev+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth ->+ (case (_lhsIstackDepth) of+ { _lhsOstackDepth ->+ ( _lhsOstackDepth) }))+ in sem_CExprAnn_Ty_1)) of+ { ( sem_CExprAnn_1) ->+ ( _lhsOrefOffset,sem_CExprAnn_1) }) }))+sem_CExprAnn_Coe :: RelevCoe ->+ T_CExprAnn+sem_CExprAnn_Coe coe_ =+ (\ _lhsIrefOffset ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CExprAnn_Coe_1 :: T_CExprAnn_1+ sem_CExprAnn_Coe_1 =+ (\ _lhsIimpNmLkup+ _lhsIlev+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth ->+ (case (_lhsIstackDepth) of+ { _lhsOstackDepth ->+ ( _lhsOstackDepth) }))+ in sem_CExprAnn_Coe_1)) of+ { ( sem_CExprAnn_1) ->+ ( _lhsOrefOffset,sem_CExprAnn_1) }) }))+sem_CExprAnn_Debug :: String ->+ T_CExprAnn+sem_CExprAnn_Debug info_ =+ (\ _lhsIrefOffset ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CExprAnn_Debug_1 :: T_CExprAnn_1+ sem_CExprAnn_Debug_1 =+ (\ _lhsIimpNmLkup+ _lhsIlev+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth ->+ (case (_lhsIstackDepth) of+ { _lhsOstackDepth ->+ ( _lhsOstackDepth) }))+ in sem_CExprAnn_Debug_1)) of+ { ( sem_CExprAnn_1) ->+ ( _lhsOrefOffset,sem_CExprAnn_1) }) }))+-- CImport -----------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ impNmL : [HsName]+ alternatives:+ alternative Import:+ child nm : {HsName}+-}+-- cata+sem_CImport :: CImport ->+ T_CImport+sem_CImport (CImport_Import _nm) =+ (sem_CImport_Import _nm)+-- semantic domain+type T_CImport = ( ([HsName]))+sem_CImport_Import :: HsName ->+ T_CImport+sem_CImport_Import nm_ =+ (case ([nm_]) of+ { _lhsOimpNmL ->+ ( _lhsOimpNmL) })+-- CImportL ----------------------------------------------------+{-+ visit 0:+ synthesized attribute:+ impNmL : [HsName]+ alternatives:+ alternative Cons:+ child hd : CImport + child tl : CImportL + alternative Nil:+-}+-- cata+sem_CImportL :: CImportL ->+ T_CImportL+sem_CImportL list =+ (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list))+-- semantic domain+type T_CImportL = ( ([HsName]))+sem_CImportL_Cons :: T_CImport ->+ T_CImportL ->+ T_CImportL+sem_CImportL_Cons hd_ tl_ =+ (case (tl_) of+ { ( _tlIimpNmL) ->+ (case (hd_) of+ { ( _hdIimpNmL) ->+ (case (_hdIimpNmL ++ _tlIimpNmL) of+ { _lhsOimpNmL ->+ ( _lhsOimpNmL) }) }) })+sem_CImportL_Nil :: T_CImportL+sem_CImportL_Nil =+ (case ([]) of+ { _lhsOimpNmL ->+ ( _lhsOimpNmL) })+-- CMetaBind ---------------------------------------------------+{-+ visit 0:+ chained attribute:+ refOffset : Int+ visit 1:+ inherited attributes:+ impNmLkup : HsName -> Maybe Int+ lev : Int+ modNr : Int+ nm2ref : CR.Nm2RefMp+ opts : EHCOpts+ chained attribute:+ stackDepth : Int+ alternatives:+ alternative Plain:+ alternative Function0:+ alternative Function1:+ alternative Apply0:+-}+-- cata+sem_CMetaBind :: CMetaBind ->+ T_CMetaBind+sem_CMetaBind (CMetaBind_Plain) =+ (sem_CMetaBind_Plain)+sem_CMetaBind (CMetaBind_Function0) =+ (sem_CMetaBind_Function0)+sem_CMetaBind (CMetaBind_Function1) =+ (sem_CMetaBind_Function1)+sem_CMetaBind (CMetaBind_Apply0) =+ (sem_CMetaBind_Apply0)+-- semantic domain+type T_CMetaBind = Int ->+ ( Int,T_CMetaBind_1)+type T_CMetaBind_1 = (HsName -> Maybe Int) ->+ Int ->+ Int ->+ (CR.Nm2RefMp) ->+ EHCOpts ->+ Int ->+ ( Int)+sem_CMetaBind_Plain :: T_CMetaBind+sem_CMetaBind_Plain =+ (\ _lhsIrefOffset ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CMetaBind_Plain_1 :: T_CMetaBind_1+ sem_CMetaBind_Plain_1 =+ (\ _lhsIimpNmLkup+ _lhsIlev+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth ->+ (case (_lhsIstackDepth) of+ { _lhsOstackDepth ->+ ( _lhsOstackDepth) }))+ in sem_CMetaBind_Plain_1)) of+ { ( sem_CMetaBind_1) ->+ ( _lhsOrefOffset,sem_CMetaBind_1) }) }))+sem_CMetaBind_Function0 :: T_CMetaBind+sem_CMetaBind_Function0 =+ (\ _lhsIrefOffset ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CMetaBind_Function0_1 :: T_CMetaBind_1+ sem_CMetaBind_Function0_1 =+ (\ _lhsIimpNmLkup+ _lhsIlev+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth ->+ (case (_lhsIstackDepth) of+ { _lhsOstackDepth ->+ ( _lhsOstackDepth) }))+ in sem_CMetaBind_Function0_1)) of+ { ( sem_CMetaBind_1) ->+ ( _lhsOrefOffset,sem_CMetaBind_1) }) }))+sem_CMetaBind_Function1 :: T_CMetaBind+sem_CMetaBind_Function1 =+ (\ _lhsIrefOffset ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CMetaBind_Function1_1 :: T_CMetaBind_1+ sem_CMetaBind_Function1_1 =+ (\ _lhsIimpNmLkup+ _lhsIlev+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth ->+ (case (_lhsIstackDepth) of+ { _lhsOstackDepth ->+ ( _lhsOstackDepth) }))+ in sem_CMetaBind_Function1_1)) of+ { ( sem_CMetaBind_1) ->+ ( _lhsOrefOffset,sem_CMetaBind_1) }) }))+sem_CMetaBind_Apply0 :: T_CMetaBind+sem_CMetaBind_Apply0 =+ (\ _lhsIrefOffset ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CMetaBind_Apply0_1 :: T_CMetaBind_1+ sem_CMetaBind_Apply0_1 =+ (\ _lhsIimpNmLkup+ _lhsIlev+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth ->+ (case (_lhsIstackDepth) of+ { _lhsOstackDepth ->+ ( _lhsOstackDepth) }))+ in sem_CMetaBind_Apply0_1)) of+ { ( sem_CMetaBind_1) ->+ ( _lhsOrefOffset,sem_CMetaBind_1) }) }))+-- CMetaVal ----------------------------------------------------+{-+ visit 0:+ chained attribute:+ refOffset : Int+ visit 1:+ inherited attributes:+ impNmLkup : HsName -> Maybe Int+ lev : Int+ modNr : Int+ nm2ref : CR.Nm2RefMp+ opts : EHCOpts+ chained attribute:+ stackDepth : Int+ alternatives:+ alternative Val:+ alternative Dict:+ alternative DictClass:+ child tracks : {[Track]}+ alternative DictInstance:+ child tracks : {[Track]}+ alternative Track:+ child track : {Track}+-}+-- cata+sem_CMetaVal :: CMetaVal ->+ T_CMetaVal+sem_CMetaVal (CMetaVal_Val) =+ (sem_CMetaVal_Val)+sem_CMetaVal (CMetaVal_Dict) =+ (sem_CMetaVal_Dict)+sem_CMetaVal (CMetaVal_DictClass _tracks) =+ (sem_CMetaVal_DictClass _tracks)+sem_CMetaVal (CMetaVal_DictInstance _tracks) =+ (sem_CMetaVal_DictInstance _tracks)+sem_CMetaVal (CMetaVal_Track _track) =+ (sem_CMetaVal_Track _track)+-- semantic domain+type T_CMetaVal = Int ->+ ( Int,T_CMetaVal_1)+type T_CMetaVal_1 = (HsName -> Maybe Int) ->+ Int ->+ Int ->+ (CR.Nm2RefMp) ->+ EHCOpts ->+ Int ->+ ( Int)+sem_CMetaVal_Val :: T_CMetaVal+sem_CMetaVal_Val =+ (\ _lhsIrefOffset ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CMetaVal_Val_1 :: T_CMetaVal_1+ sem_CMetaVal_Val_1 =+ (\ _lhsIimpNmLkup+ _lhsIlev+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth ->+ (case (_lhsIstackDepth) of+ { _lhsOstackDepth ->+ ( _lhsOstackDepth) }))+ in sem_CMetaVal_Val_1)) of+ { ( sem_CMetaVal_1) ->+ ( _lhsOrefOffset,sem_CMetaVal_1) }) }))+sem_CMetaVal_Dict :: T_CMetaVal+sem_CMetaVal_Dict =+ (\ _lhsIrefOffset ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CMetaVal_Dict_1 :: T_CMetaVal_1+ sem_CMetaVal_Dict_1 =+ (\ _lhsIimpNmLkup+ _lhsIlev+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth ->+ (case (_lhsIstackDepth) of+ { _lhsOstackDepth ->+ ( _lhsOstackDepth) }))+ in sem_CMetaVal_Dict_1)) of+ { ( sem_CMetaVal_1) ->+ ( _lhsOrefOffset,sem_CMetaVal_1) }) }))+sem_CMetaVal_DictClass :: ([Track]) ->+ T_CMetaVal+sem_CMetaVal_DictClass tracks_ =+ (\ _lhsIrefOffset ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CMetaVal_DictClass_1 :: T_CMetaVal_1+ sem_CMetaVal_DictClass_1 =+ (\ _lhsIimpNmLkup+ _lhsIlev+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth ->+ (case (_lhsIstackDepth) of+ { _lhsOstackDepth ->+ ( _lhsOstackDepth) }))+ in sem_CMetaVal_DictClass_1)) of+ { ( sem_CMetaVal_1) ->+ ( _lhsOrefOffset,sem_CMetaVal_1) }) }))+sem_CMetaVal_DictInstance :: ([Track]) ->+ T_CMetaVal+sem_CMetaVal_DictInstance tracks_ =+ (\ _lhsIrefOffset ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CMetaVal_DictInstance_1 :: T_CMetaVal_1+ sem_CMetaVal_DictInstance_1 =+ (\ _lhsIimpNmLkup+ _lhsIlev+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth ->+ (case (_lhsIstackDepth) of+ { _lhsOstackDepth ->+ ( _lhsOstackDepth) }))+ in sem_CMetaVal_DictInstance_1)) of+ { ( sem_CMetaVal_1) ->+ ( _lhsOrefOffset,sem_CMetaVal_1) }) }))+sem_CMetaVal_Track :: Track ->+ T_CMetaVal+sem_CMetaVal_Track track_ =+ (\ _lhsIrefOffset ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CMetaVal_Track_1 :: T_CMetaVal_1+ sem_CMetaVal_Track_1 =+ (\ _lhsIimpNmLkup+ _lhsIlev+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth ->+ (case (_lhsIstackDepth) of+ { _lhsOstackDepth ->+ ( _lhsOstackDepth) }))+ in sem_CMetaVal_Track_1)) of+ { ( sem_CMetaVal_1) ->+ ( _lhsOrefOffset,sem_CMetaVal_1) }) }))+-- CMetas ------------------------------------------------------+{-+ visit 0:+ chained attribute:+ refOffset : Int+ visit 1:+ inherited attributes:+ impNmLkup : HsName -> Maybe Int+ lev : Int+ modNr : Int+ nm2ref : CR.Nm2RefMp+ opts : EHCOpts+ chained attribute:+ stackDepth : Int+ alternatives:+ alternative Tuple:+ child x1 : CMetaBind + child x2 : CMetaVal +-}+-- cata+sem_CMetas :: CMetas ->+ T_CMetas+sem_CMetas ( x1,x2) =+ (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2))+-- semantic domain+type T_CMetas = Int ->+ ( Int,T_CMetas_1)+type T_CMetas_1 = (HsName -> Maybe Int) ->+ Int ->+ Int ->+ (CR.Nm2RefMp) ->+ EHCOpts ->+ Int ->+ ( Int)+sem_CMetas_Tuple :: T_CMetaBind ->+ T_CMetaVal ->+ T_CMetas+sem_CMetas_Tuple x1_ x2_ =+ (\ _lhsIrefOffset ->+ (case (_lhsIrefOffset) of+ { _x1OrefOffset ->+ (case (x1_ _x1OrefOffset) of+ { ( _x1IrefOffset,x1_1) ->+ (case (_x1IrefOffset) of+ { _x2OrefOffset ->+ (case (x2_ _x2OrefOffset) of+ { ( _x2IrefOffset,x2_1) ->+ (case (_x2IrefOffset) of+ { _lhsOrefOffset ->+ (case ((let sem_CMetas_Tuple_1 :: T_CMetas_1+ sem_CMetas_Tuple_1 =+ (\ _lhsIimpNmLkup+ _lhsIlev+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIstackDepth ->+ (case (_lhsIstackDepth) of+ { _x1OstackDepth ->+ (case (_lhsIopts) of+ { _x1Oopts ->+ (case (_lhsInm2ref) of+ { _x1Onm2ref ->+ (case (_lhsImodNr) of+ { _x1OmodNr ->+ (case (_lhsIlev) of+ { _x1Olev ->+ (case (_lhsIimpNmLkup) of+ { _x1OimpNmLkup ->+ (case (x1_1 _x1OimpNmLkup _x1Olev _x1OmodNr _x1Onm2ref _x1Oopts _x1OstackDepth) of+ { ( _x1IstackDepth) ->+ (case (_x1IstackDepth) of+ { _x2OstackDepth ->+ (case (_lhsIopts) of+ { _x2Oopts ->+ (case (_lhsInm2ref) of+ { _x2Onm2ref ->+ (case (_lhsImodNr) of+ { _x2OmodNr ->+ (case (_lhsIlev) of+ { _x2Olev ->+ (case (_lhsIimpNmLkup) of+ { _x2OimpNmLkup ->+ (case (x2_1 _x2OimpNmLkup _x2Olev _x2OmodNr _x2Onm2ref _x2Oopts _x2OstackDepth) of+ { ( _x2IstackDepth) ->+ (case (_x2IstackDepth) of+ { _lhsOstackDepth ->+ ( _lhsOstackDepth) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+ in sem_CMetas_Tuple_1)) of+ { ( sem_CMetas_1) ->+ ( _lhsOrefOffset,sem_CMetas_1) }) }) }) }) }) }))+-- CModule -----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ hasMain : Bool+ lev : Int+ modNr : Int+ nm2ref : CR.Nm2RefMp+ opts : EHCOpts+ synthesized attributes:+ crm : CR.Mod+ nm2refGath : CR.Nm2RefMp+ alternatives:+ alternative Mod:+ child moduleNm : {HsName}+ child exports : CExportL + child imports : CImportL + child declMetas : CDeclMetaL + child expr : CExpr + visit 0:+ local whatAbove : {WhatExpr}+ local tailCtx : _+ local impNmLkup : _+ local nm2refNew : _+ local crmBinds : _+ local creMod : _+-}+-- cata+sem_CModule :: CModule ->+ T_CModule+sem_CModule (CModule_Mod _moduleNm _exports _imports _declMetas _expr) =+ (sem_CModule_Mod _moduleNm (sem_CExportL _exports) (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr))+-- semantic domain+type T_CModule = Bool ->+ Int ->+ Int ->+ (CR.Nm2RefMp) ->+ EHCOpts ->+ ( (CR.Mod),(CR.Nm2RefMp))+sem_CModule_Mod :: HsName ->+ T_CExportL ->+ T_CImportL ->+ T_CDeclMetaL ->+ T_CExpr ->+ T_CModule+sem_CModule_Mod moduleNm_ exports_ imports_ declMetas_ expr_ =+ (\ _lhsIhasMain+ _lhsIlev+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts ->+ (case (ExprIsOther) of+ { _whatAbove ->+ (case (_whatAbove) of+ { _exprOwhatAbove ->+ (case (TailCtx_Plain) of+ { _tailCtx ->+ (case (_tailCtx) of+ { _exprOtailCtx ->+ (case (_lhsIlev) of+ { _exprOlev ->+ (case (imports_) of+ { ( _importsIimpNmL) ->+ (case (\n -> elemIndex n _importsIimpNmL) of+ { _impNmLkup ->+ (case (_impNmLkup) of+ { _exprOimpNmLkup ->+ (case (0) of+ { _exprOrefOffset ->+ (case (expr_) of+ { ( _exprIwhatBelow,expr_1) ->+ (case (expr_1 _exprOlev _exprOrefOffset _exprOwhatAbove) of+ { ( _exprInm2refGath,_exprIrefOffset,expr_2) ->+ (case (_exprInm2refGath) of+ { _nm2refNew ->+ (case (_nm2refNew `CR.nm2refUnion` _lhsInm2ref) of+ { _exprOnm2ref ->+ (case (0) of+ { _exprOstackDepth ->+ (case (_lhsIopts) of+ { _exprOopts ->+ (case (_lhsImodNr) of+ { _exprOmodNr ->+ (case (EvalCtx_Eval) of+ { _exprOevalCtx ->+ (case (True) of+ { _exprOisTopTup ->+ (case (True) of+ { _exprOisTopApp ->+ (case (expr_2 _exprOevalCtx _exprOimpNmLkup _exprOisTopApp _exprOisTopTup _exprOmodNr _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of+ { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax,_exprIvref) ->+ (case (CR.crarrayFromList $ map snd _exprIcrb) of+ { _crmBinds ->+ (case (_exprIcre) of+ { _creMod ->+ (case (declMetas_) of+ { ( _declMetasIcrmt) ->+ (case (CR.Mod_Mod (CR.nm2RefMpInverse _nm2refNew)+ moduleNm_ _lhsImodNr (_exprIstackDepthMax + 2 )+ (map CR.Import_Import _importsIimpNmL)+ _declMetasIcrmt _crmBinds (if _lhsIhasMain then (Just $ CR.mkEval _creMod) else Nothing)) of+ { _lhsOcrm ->+ (case (Rel.mapRng (CR.rrefToExp moduleNm_) _exprInm2refGath) of+ { _lhsOnm2refGath ->+ ( _lhsOcrm,_lhsOnm2refGath) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+-- CPat --------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ impNmLkup : HsName -> Maybe Int+ lev : Int+ modNr : Int+ nm2ref : CR.Nm2RefMp+ opts : EHCOpts+ chained attributes:+ refOffset : Int+ stackDepth : Int+ synthesized attributes:+ crp : CR.Pat+ fldNmL : [HsName]+ alternatives:+ alternative Var:+ child pnm : {HsName}+ alternative Con:+ child tag : {CTag}+ child rest : CPatRest + child binds : CPatFldL + alternative Int:+ child int : {Int}+ alternative Char:+ child char : {Char}+ alternative BoolExpr:+ child cexpr : {CExpr}+-}+-- cata+sem_CPat :: CPat ->+ T_CPat+sem_CPat (CPat_Var _pnm) =+ (sem_CPat_Var _pnm)+sem_CPat (CPat_Con _tag _rest _binds) =+ (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds))+sem_CPat (CPat_Int _int) =+ (sem_CPat_Int _int)+sem_CPat (CPat_Char _char) =+ (sem_CPat_Char _char)+sem_CPat (CPat_BoolExpr _cexpr) =+ (sem_CPat_BoolExpr _cexpr)+-- semantic domain+type T_CPat = (HsName -> Maybe Int) ->+ Int ->+ Int ->+ (CR.Nm2RefMp) ->+ EHCOpts ->+ Int ->+ Int ->+ ( (CR.Pat),([HsName]),Int,Int)+sem_CPat_Var :: HsName ->+ T_CPat+sem_CPat_Var pnm_ =+ (\ _lhsIimpNmLkup+ _lhsIlev+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIrefOffset+ _lhsIstackDepth ->+ (case (CR.Pat_Con 0) of+ { _lhsOcrp ->+ (case ([]) of+ { _lhsOfldNmL ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case (_lhsIstackDepth) of+ { _lhsOstackDepth ->+ ( _lhsOcrp,_lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) }) }))+sem_CPat_Con :: CTag ->+ T_CPatRest ->+ T_CPatFldL ->+ T_CPat+sem_CPat_Con tag_ rest_ binds_ =+ (\ _lhsIimpNmLkup+ _lhsIlev+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIrefOffset+ _lhsIstackDepth ->+ (case (CR.Pat_Con (ctagTag tag_)) of+ { _lhsOcrp ->+ (case (_lhsIstackDepth) of+ { _restOstackDepth ->+ (case (_lhsIrefOffset) of+ { _restOrefOffset ->+ (case (_lhsIopts) of+ { _restOopts ->+ (case (_lhsInm2ref) of+ { _restOnm2ref ->+ (case (_lhsImodNr) of+ { _restOmodNr ->+ (case (_lhsIlev) of+ { _restOlev ->+ (case (_lhsIimpNmLkup) of+ { _restOimpNmLkup ->+ (case (rest_ _restOimpNmLkup _restOlev _restOmodNr _restOnm2ref _restOopts _restOrefOffset _restOstackDepth) of+ { ( _restIrefOffset,_restIstackDepth) ->+ (case (_restIstackDepth) of+ { _bindsOstackDepth ->+ (case (_restIrefOffset) of+ { _bindsOrefOffset ->+ (case (_lhsIopts) of+ { _bindsOopts ->+ (case (_lhsInm2ref) of+ { _bindsOnm2ref ->+ (case (_lhsImodNr) of+ { _bindsOmodNr ->+ (case (_lhsIlev) of+ { _bindsOlev ->+ (case (_lhsIimpNmLkup) of+ { _bindsOimpNmLkup ->+ (case (binds_ _bindsOimpNmLkup _bindsOlev _bindsOmodNr _bindsOnm2ref _bindsOopts _bindsOrefOffset _bindsOstackDepth) of+ { ( _bindsIfldNmL,_bindsIrefOffset,_bindsIstackDepth) ->+ (case (_bindsIfldNmL) of+ { _lhsOfldNmL ->+ (case (_bindsIrefOffset) of+ { _lhsOrefOffset ->+ (case (_bindsIstackDepth) of+ { _lhsOstackDepth ->+ ( _lhsOcrp,_lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+sem_CPat_Int :: Int ->+ T_CPat+sem_CPat_Int int_ =+ (\ _lhsIimpNmLkup+ _lhsIlev+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIrefOffset+ _lhsIstackDepth ->+ (case (CR.Pat_Con 0) of+ { _lhsOcrp ->+ (case ([]) of+ { _lhsOfldNmL ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case (_lhsIstackDepth) of+ { _lhsOstackDepth ->+ ( _lhsOcrp,_lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) }) }))+sem_CPat_Char :: Char ->+ T_CPat+sem_CPat_Char char_ =+ (\ _lhsIimpNmLkup+ _lhsIlev+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIrefOffset+ _lhsIstackDepth ->+ (case (CR.Pat_Con 0) of+ { _lhsOcrp ->+ (case ([]) of+ { _lhsOfldNmL ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case (_lhsIstackDepth) of+ { _lhsOstackDepth ->+ ( _lhsOcrp,_lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) }) }))+sem_CPat_BoolExpr :: CExpr ->+ T_CPat+sem_CPat_BoolExpr cexpr_ =+ (\ _lhsIimpNmLkup+ _lhsIlev+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIrefOffset+ _lhsIstackDepth ->+ (case (CR.Pat_Con 0) of+ { _lhsOcrp ->+ (case ([]) of+ { _lhsOfldNmL ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case (_lhsIstackDepth) of+ { _lhsOstackDepth ->+ ( _lhsOcrp,_lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) }) }))+-- CPatFld -----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ impNmLkup : HsName -> Maybe Int+ lev : Int+ modNr : Int+ nm2ref : CR.Nm2RefMp+ opts : EHCOpts+ chained attributes:+ refOffset : Int+ stackDepth : Int+ synthesized attribute:+ fldNmL : [HsName]+ alternatives:+ alternative Fld:+ child lbl : {HsName}+ child offset : CExpr + child bind : CBind + child fldAnns : CBindAnnL + visit 0:+ local whatAbove : {WhatExpr}+ local fldNm : _+ local tailCtx : _+-}+-- cata+sem_CPatFld :: CPatFld ->+ T_CPatFld+sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) =+ (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns))+-- semantic domain+type T_CPatFld = (HsName -> Maybe Int) ->+ Int ->+ Int ->+ (CR.Nm2RefMp) ->+ EHCOpts ->+ Int ->+ Int ->+ ( ([HsName]),Int,Int)+sem_CPatFld_Fld :: HsName ->+ T_CExpr ->+ T_CBind ->+ T_CBindAnnL ->+ T_CPatFld+sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ =+ (\ _lhsIimpNmLkup+ _lhsIlev+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIrefOffset+ _lhsIstackDepth ->+ (case (_lhsIrefOffset) of+ { _offsetOrefOffset ->+ (case (offset_) of+ { ( _offsetIwhatBelow,offset_1) ->+ (case (ExprIsOther) of+ { _whatAbove ->+ (case (_whatAbove) of+ { _offsetOwhatAbove ->+ (case (_lhsIlev) of+ { _offsetOlev ->+ (case (offset_1 _offsetOlev _offsetOrefOffset _offsetOwhatAbove) of+ { ( _offsetInm2refGath,_offsetIrefOffset,offset_2) ->+ (case (_offsetIrefOffset) of+ { _bindOrefOffset ->+ (case (_lhsIlev) of+ { _bindOlev ->+ (case (False) of+ { _bindOisGlobal ->+ (case (bind_ _bindOisGlobal _bindOlev _bindOrefOffset) of+ { ( _bindInm,_bindInm2refGath,_bindIrefOffset,bind_1) ->+ (case (_bindInm) of+ { _fldNm ->+ (case ([_fldNm]) of+ { _lhsOfldNmL ->+ (case (_bindIrefOffset) of+ { _fldAnnsOrefOffset ->+ (case (_lhsIstackDepth) of+ { _offsetOstackDepth ->+ (case (TailCtx_Plain) of+ { _tailCtx ->+ (case (_tailCtx) of+ { _offsetOtailCtx ->+ (case (_lhsIopts) of+ { _offsetOopts ->+ (case (_lhsInm2ref) of+ { _offsetOnm2ref ->+ (case (_lhsImodNr) of+ { _offsetOmodNr ->+ (case (_lhsIimpNmLkup) of+ { _offsetOimpNmLkup ->+ (case (EvalCtx_Eval) of+ { _offsetOevalCtx ->+ (case (True) of+ { _offsetOisTopTup ->+ (case (True) of+ { _offsetOisTopApp ->+ (case (offset_2 _offsetOevalCtx _offsetOimpNmLkup _offsetOisTopApp _offsetOisTopTup _offsetOmodNr _offsetOnm2ref _offsetOopts _offsetOstackDepth _offsetOtailCtx) of+ { ( _offsetIappFunKind,_offsetIcrb,_offsetIcre,_offsetIcreAppArgL,_offsetIcreAppFun,_offsetIcreLamArgL,_offsetIcreLamBody,_offsetIcrse,_offsetImbFFIApp,_offsetImbLam,_offsetImbVar,_offsetIrefOffsetMax,_offsetIstackDepth,_offsetIstackDepthMax,_offsetIvref) ->+ (case (_offsetIstackDepth) of+ { _bindOstackDepth ->+ (case (EvalCtx_None) of+ { _bindOevalCtx ->+ (case (_lhsIopts) of+ { _bindOopts ->+ (case (_lhsInm2ref) of+ { _bindOnm2ref ->+ (case (_lhsImodNr) of+ { _bindOmodNr ->+ (case (_lhsIimpNmLkup) of+ { _bindOimpNmLkup ->+ (case (acoreBindcategPlain) of+ { _bindOletBindingsCateg ->+ (case (bind_1 _bindOevalCtx _bindOimpNmLkup _bindOletBindingsCateg _bindOmodNr _bindOnm2ref _bindOopts _bindOstackDepth) of+ { ( _bindIcrb,_bindIrefOffsetMax,_bindIstackDepth,_bindIstackDepthMax) ->+ (case (_bindIstackDepth) of+ { _fldAnnsOstackDepth ->+ (case (_lhsIopts) of+ { _fldAnnsOopts ->+ (case (_lhsInm2ref) of+ { _fldAnnsOnm2ref ->+ (case (_lhsImodNr) of+ { _fldAnnsOmodNr ->+ (case (_lhsIlev) of+ { _fldAnnsOlev ->+ (case (_lhsIimpNmLkup) of+ { _fldAnnsOimpNmLkup ->+ (case (fldAnns_ _fldAnnsOimpNmLkup _fldAnnsOlev _fldAnnsOmodNr _fldAnnsOnm2ref _fldAnnsOopts _fldAnnsOrefOffset _fldAnnsOstackDepth) of+ { ( _fldAnnsIrefOffset,_fldAnnsIstackDepth) ->+ (case (_fldAnnsIrefOffset) of+ { _lhsOrefOffset ->+ (case (_fldAnnsIstackDepth) of+ { _lhsOstackDepth ->+ ( _lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+-- CPatFldL ----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ impNmLkup : HsName -> Maybe Int+ lev : Int+ modNr : Int+ nm2ref : CR.Nm2RefMp+ opts : EHCOpts+ chained attributes:+ refOffset : Int+ stackDepth : Int+ synthesized attribute:+ fldNmL : [HsName]+ alternatives:+ alternative Cons:+ child hd : CPatFld + child tl : CPatFldL + alternative Nil:+-}+-- cata+sem_CPatFldL :: CPatFldL ->+ T_CPatFldL+sem_CPatFldL list =+ (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list))+-- semantic domain+type T_CPatFldL = (HsName -> Maybe Int) ->+ Int ->+ Int ->+ (CR.Nm2RefMp) ->+ EHCOpts ->+ Int ->+ Int ->+ ( ([HsName]),Int,Int)+sem_CPatFldL_Cons :: T_CPatFld ->+ T_CPatFldL ->+ T_CPatFldL+sem_CPatFldL_Cons hd_ tl_ =+ (\ _lhsIimpNmLkup+ _lhsIlev+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIrefOffset+ _lhsIstackDepth ->+ (case (_lhsIstackDepth) of+ { _hdOstackDepth ->+ (case (_lhsIrefOffset) of+ { _hdOrefOffset ->+ (case (_lhsIlev) of+ { _hdOlev ->+ (case (_lhsIopts) of+ { _hdOopts ->+ (case (_lhsInm2ref) of+ { _hdOnm2ref ->+ (case (_lhsImodNr) of+ { _hdOmodNr ->+ (case (_lhsIimpNmLkup) of+ { _hdOimpNmLkup ->+ (case (hd_ _hdOimpNmLkup _hdOlev _hdOmodNr _hdOnm2ref _hdOopts _hdOrefOffset _hdOstackDepth) of+ { ( _hdIfldNmL,_hdIrefOffset,_hdIstackDepth) ->+ (case (_hdIstackDepth) of+ { _tlOstackDepth ->+ (case (_hdIrefOffset) of+ { _tlOrefOffset ->+ (case (_lhsIopts) of+ { _tlOopts ->+ (case (_lhsInm2ref) of+ { _tlOnm2ref ->+ (case (_lhsImodNr) of+ { _tlOmodNr ->+ (case (_lhsIlev) of+ { _tlOlev ->+ (case (_lhsIimpNmLkup) of+ { _tlOimpNmLkup ->+ (case (tl_ _tlOimpNmLkup _tlOlev _tlOmodNr _tlOnm2ref _tlOopts _tlOrefOffset _tlOstackDepth) of+ { ( _tlIfldNmL,_tlIrefOffset,_tlIstackDepth) ->+ (case (_hdIfldNmL ++ _tlIfldNmL) of+ { _lhsOfldNmL ->+ (case (_tlIrefOffset) of+ { _lhsOrefOffset ->+ (case (_tlIstackDepth) of+ { _lhsOstackDepth ->+ ( _lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))+sem_CPatFldL_Nil :: T_CPatFldL+sem_CPatFldL_Nil =+ (\ _lhsIimpNmLkup+ _lhsIlev+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIrefOffset+ _lhsIstackDepth ->+ (case ([]) of+ { _lhsOfldNmL ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case (_lhsIstackDepth) of+ { _lhsOstackDepth ->+ ( _lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) }))+-- CPatRest ----------------------------------------------------+{-+ visit 0:+ inherited attributes:+ impNmLkup : HsName -> Maybe Int+ lev : Int+ modNr : Int+ nm2ref : CR.Nm2RefMp+ opts : EHCOpts+ chained attributes:+ refOffset : Int+ stackDepth : Int+ alternatives:+ alternative Var:+ child nm : {HsName}+ alternative Empty:+-}+-- cata+sem_CPatRest :: CPatRest ->+ T_CPatRest+sem_CPatRest (CPatRest_Var _nm) =+ (sem_CPatRest_Var _nm)+sem_CPatRest (CPatRest_Empty) =+ (sem_CPatRest_Empty)+-- semantic domain+type T_CPatRest = (HsName -> Maybe Int) ->+ Int ->+ Int ->+ (CR.Nm2RefMp) ->+ EHCOpts ->+ Int ->+ Int ->+ ( Int,Int)+sem_CPatRest_Var :: HsName ->+ T_CPatRest+sem_CPatRest_Var nm_ =+ (\ _lhsIimpNmLkup+ _lhsIlev+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIrefOffset+ _lhsIstackDepth ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case (_lhsIstackDepth) of+ { _lhsOstackDepth ->+ ( _lhsOrefOffset,_lhsOstackDepth) }) }))+sem_CPatRest_Empty :: T_CPatRest+sem_CPatRest_Empty =+ (\ _lhsIimpNmLkup+ _lhsIlev+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts+ _lhsIrefOffset+ _lhsIstackDepth ->+ (case (_lhsIrefOffset) of+ { _lhsOrefOffset ->+ (case (_lhsIstackDepth) of+ { _lhsOstackDepth ->+ ( _lhsOrefOffset,_lhsOstackDepth) }) }))+-- CodeAGItf ---------------------------------------------------+{-+ visit 0:+ inherited attributes:+ hasMain : Bool+ modNr : Int+ nm2ref : CR.Nm2RefMp+ opts : EHCOpts+ synthesized attributes:+ crm : CR.Mod+ nm2refGath : CR.Nm2RefMp+ alternatives:+ alternative AGItf:+ child module : CModule +-}+-- cata+sem_CodeAGItf :: CodeAGItf ->+ T_CodeAGItf+sem_CodeAGItf (CodeAGItf_AGItf _module) =+ (sem_CodeAGItf_AGItf (sem_CModule _module))+-- semantic domain+type T_CodeAGItf = Bool ->+ Int ->+ (CR.Nm2RefMp) ->+ EHCOpts ->+ ( (CR.Mod),(CR.Nm2RefMp))+data Inh_CodeAGItf = Inh_CodeAGItf {hasMain_Inh_CodeAGItf :: !(Bool),modNr_Inh_CodeAGItf :: !(Int),nm2ref_Inh_CodeAGItf :: !((CR.Nm2RefMp)),opts_Inh_CodeAGItf :: !(EHCOpts)}+data Syn_CodeAGItf = Syn_CodeAGItf {crm_Syn_CodeAGItf :: !((CR.Mod)),nm2refGath_Syn_CodeAGItf :: !((CR.Nm2RefMp))}+wrap_CodeAGItf :: T_CodeAGItf ->+ Inh_CodeAGItf ->+ Syn_CodeAGItf+wrap_CodeAGItf sem (Inh_CodeAGItf _lhsIhasMain _lhsImodNr _lhsInm2ref _lhsIopts) =+ (let ( _lhsOcrm,_lhsOnm2refGath) = sem _lhsIhasMain _lhsImodNr _lhsInm2ref _lhsIopts+ in (Syn_CodeAGItf _lhsOcrm _lhsOnm2refGath))+sem_CodeAGItf_AGItf :: T_CModule ->+ T_CodeAGItf+sem_CodeAGItf_AGItf module_ =+ (\ _lhsIhasMain+ _lhsImodNr+ _lhsInm2ref+ _lhsIopts ->+ (case (_lhsInm2ref) of+ { _moduleOnm2ref ->+ (case (_lhsImodNr) of+ { _moduleOmodNr ->+ (case (_lhsIhasMain) of+ { _moduleOhasMain ->+ (case (cLevModule) of+ { _moduleOlev ->+ (case (_lhsIopts) of+ { _moduleOopts ->+ (case (module_ _moduleOhasMain _moduleOlev _moduleOmodNr _moduleOnm2ref _moduleOopts) of+ { ( _moduleIcrm,_moduleInm2refGath) ->+ (case (_moduleIcrm) of+ { _lhsOcrm ->+ (case (_moduleInm2refGath) of+ { _lhsOnm2refGath ->+ ( _lhsOcrm,_lhsOnm2refGath) }) }) }) }) }) }) }) }))
@@ -79,7 +79,7 @@ isLamLifted = not isNotLamLifted isANormal = not isNotANormal noOptims = ehcOptOptimizationLevel opts <= OptimizationLevel_Off- isCoreTarget = targetIsCore $ ehcOptTarget opts+ isCoreTarget = targetIsCoreVariation $ ehcOptTarget opts isUnOptimCoreTarget = isCoreTarget && noOptims trf = do { -- initial is just to obtain Core for dumping stages
@@ -2,8 +2,9 @@ -- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/CoreRun.ag) module UHC.Light.Compiler.CoreRun(module UHC.Light.Compiler.CoreRun.Prim-, Mod (..), SExp (..), Exp (..), Alt (..), Pat (..)-, Meta (..), MetaL, DataCon (..), DataConL+, AGItf (..)+, Mod (..), SExp (..), Exp (..), MbExp, Alt (..), Pat (..)+, Meta (..), MetaL, DataCon (..), DataConL, Import (..), ImportL , CRArray, CRMArray, emptyCRArray, crarrayToList, crarrayFromList, craLength, craAssocs, craAssocs', craReverseAssocs' , Bind , dbgs, dbg@@ -12,18 +13,22 @@ , RRef (..), noRRef , rrefToDif , Ref2Nm-, Nm2RefMp, emptyNm2RefMp, nm2refUnion, nm2RefMpInverse, ref2nmEmpty, ref2nmUnion-, mkLocLevRef, mkLocDifRef, mkGlobRef+, Nm2RefMp, emptyNm2RefMp, nm2refUnion, nm2RefMpInverse, nm2refLookup+, ref2nmEmpty, ref2nmUnion, ref2nmLookup+, mkLocLevRef, mkLocDifRef, mkGlobRef, mkImpRef, mkModRef , mkExp, mkVar, mkVar', mkInt, mkInt', mkChar, mkChar', mkString, mkString' , mkDbg, mkDbg' , mkApp, mkApp', mkTup, mkTup', mkEval, mkTail, mkCase, mkLam, mkLam', mkLet, mkLet', mkFFI, mkFFI'+, mkImport , mkMetaDataCon, mkMetaDataType-, mkMod, mkMod', mkMod''+, mkMod, mkMod', mkModWithMetas, mkModWithImportsMetas+, rrefToImp, rrefToExp , mkInteger, mkInteger') where import UHC.Light.Compiler.Base.Common import UHC.Light.Compiler.Base.Target import UHC.Util.Utils+import qualified UHC.Util.RelMap as Rel import UHC.Light.Compiler.Ty import qualified Data.Map as Map import Data.Maybe@@ -33,6 +38,9 @@ import qualified Data.Vector.Mutable as MV import Control.Applicative import UHC.Light.Compiler.CoreRun.Prim+import Control.Monad+import UHC.Util.Binary+import UHC.Util.Serialize import UHC.Light.Compiler.Foreign @@ -59,6 +67,12 @@ ++++++ -- | Fast access sequence type CRArray x = V.Vector x type CRMArray x = MV.IOVector x@@ -133,11 +147,25 @@ -- | Identifier references for use during running CoreRun data RRef- -- | global reference to module and its entry+ -- | global reference to module and its entry, will become obsolete, to be replaced by 'RRef_Mod' and 'RRef_Glb' = RRef_Glb { rrefMod :: !Int -- ^ module , rrefEntry :: !Int -- ^ entry inside module }+ -- | entry of current module reference+ | RRef_Mod+ { rrefEntry :: !Int -- ^ entry inside module, in its frame+ }+ -- | exported entry of module reference, only used internally to be later resolved to a 'RRef_Imp'+ | RRef_Exp+ { rrefModNm :: !HsName -- ^ module name, to be looked up in a module specific import list for an index+ , rrefEntry :: !Int -- ^ entry inside module, in its frame+ }+ -- | imported entry of module reference+ | RRef_Imp+ { rrefMod :: !Int -- ^ module (sequence) nr as it appears in the imported module list+ , rrefEntry :: !Int -- ^ entry inside module, in its frame+ } -- | local reference to on stack value, not interpreted during running, if used must be converted with 'rrefToDif' before running; may become obsolete. | RRef_Loc { rrefLev :: !Int -- ^ level when used statically@@ -168,48 +196,198 @@ noRRef = RRef_Dbg hsnUnknown +-- | Map over the non-recursive parts of RRef+mapRRef :: (RRef -> RRef) -> RRef -> RRef+mapRRef f r@(RRef_Fld {rrefRef=r'}) = r {rrefRef = mapRRef f r'}+mapRRef f r@(RRef_Tag {rrefRef=r'}) = r {rrefRef = mapRRef f r'}+mapRRef f r = f r ++-- | Convert to RRef_Exp to RRef_Imp, i.e. named module to indexed module ref+rrefToImp :: (HsName -> Maybe Int) -> RRef -> RRef+rrefToImp lkup = mapRRef f+ where f r@(RRef_Exp n o) = maybe (RRef_Dbg n) (flip RRef_Imp o) $ lkup $ panicJust "rrefToImp" $ hsnQualifier n+ f r = r++-- | Convert to RRef_Mod to RRef_Exp, i.e. local module ref to exported+rrefToExp :: HsName -> RRef -> RRef+rrefToExp nm = mapRRef f+ where f r@(RRef_Mod o) = RRef_Exp nm o+ f r = r+++ -- | Convert to RRef_Loc to RRef_LDf, i.e. absolute level to relative (to current) level+rrefToDif :: Int -> RRef -> RRef+rrefToDif curlev = mapRRef f+ where f r@(RRef_Loc l o) = RRef_LDf (curlev - l) o+ f r = r+{- rrefToDif curlev r@(RRef_Loc l o ) = RRef_LDf (curlev - l) o rrefToDif curlev r@(RRef_Fld {rrefRef=r'}) = r {rrefRef = rrefToDif curlev r'} rrefToDif curlev r@(RRef_Tag {rrefRef=r'}) = r {rrefRef = rrefToDif curlev r'} rrefToDif _ r = r+-} -- | RRef to HsName mapping for use during running when a more informative name is required. -- The representation is lazily via function-type Ref2Nm = RRef -> Maybe HsName+type Nm2RefRel = Rel.Rel HsName RRef -- RRef -> Maybe HsName +-- | RRef to HsName mapping for use during running when a more informative name is required.+-- The representation is lazily via function+type Ref2Nm = Nm2RefRel -- RRef -> Maybe HsName+++ -- | HsName to RRef mapping for resolving references during translation to CoreRun-type Nm2RefMp = Map.Map HsName RRef+type Nm2RefMp = Nm2RefRel -- Map.Map HsName RRef emptyNm2RefMp :: Nm2RefMp-emptyNm2RefMp = Map.empty+emptyNm2RefMp = Rel.empty -- Map.empty nm2refUnion :: Nm2RefMp -> Nm2RefMp -> Nm2RefMp-nm2refUnion = Map.union+nm2refUnion = Rel.union -- Map.union +nm2refLookup :: HsName -> Nm2RefMp -> Maybe RRef+nm2refLookup = Rel.lookup+ -- | Inverse of a `Nm2RefMp` nm2RefMpInverse :: Nm2RefMp -> Ref2Nm-nm2RefMpInverse m+nm2RefMpInverse m = m+{- | Map.null m = const Nothing | otherwise = flip Map.lookup inv where inv = Map.fromList [ (r,n) | (n,r) <- Map.toList m ]+-} ++ -- | Empty Ref2Nm ref2nmEmpty :: Ref2Nm-ref2nmEmpty = const Nothing+ref2nmEmpty = Rel.empty -- const Nothing +ref2nmLookup :: RRef -> Ref2Nm -> Maybe HsName+ref2nmLookup = Rel.lookupInverse+ -- | Union, left-biased ref2nmUnion :: Ref2Nm -> Ref2Nm -> Ref2Nm-ref2nmUnion m1 m2 = \r -> m1 r <|> m2 r+ref2nmUnion = Rel.union -- m1 m2 = \r -> m1 r <|> m2 r +instance Binary Mod where+ put (Mod_Mod a b c d e f g h) = put a >> put b >> put c >> put d >> put e >> put f >> put g >> put h+ get = liftM8 Mod_Mod get get get get get get get get++instance Serialize Mod where+ sput = sputPlain+ sget = sgetPlain++instance Binary Meta where+ put (Meta_Data a b) = {- putWord8 0 >> -} put a >> put b+ get = {- do t <- getWord8+ case t of+ 0 -> -} liftM2 Meta_Data get get++instance Binary Import where+ put (Import_Import a) = {- putWord8 0 >> -} put a+ get = {- do t <- getWord8+ case t of+ 0 -> -} liftM Import_Import get++instance Binary DataCon where+ put (DataCon_Con a b) = {- putWord8 0 >> -} put a >> put b+ get = {- do t <- getWord8+ case t of+ 0 -> -} liftM2 DataCon_Con get get++instance Binary Exp where+ put (Exp_SExp a ) = putWord8 0 >> put a+ put (Exp_Tup a b ) = putWord8 1 >> put a >> put b+ put (Exp_Let a b c d ) = putWord8 2 >> put a >> put b >> put c >> put d+ put (Exp_App a b ) = putWord8 3 >> put a >> put b+ put (Exp_Lam a b c d e ) = putWord8 4 >> put a >> put b >> put c >> put d >> put e+ put (Exp_Force a ) = putWord8 5 >> put a+ put (Exp_Tail a ) = putWord8 6 >> put a+ put (Exp_Case a b ) = putWord8 7 >> put a >> put b+ put (Exp_FFI a b ) = putWord8 8 >> put a >> put b+ get = do t <- getWord8+ case t of+ 0 -> liftM Exp_SExp get+ 1 -> liftM2 Exp_Tup get get+ 2 -> liftM4 Exp_Let get get get get+ 3 -> liftM2 Exp_App get get+ 4 -> liftM5 Exp_Lam get get get get get+ 5 -> liftM Exp_Force get+ 6 -> liftM Exp_Tail get+ 7 -> liftM2 Exp_Case get get+ 8 -> liftM2 Exp_FFI get get++instance Binary SExp where+ put (SExp_Var a ) = putWord8 0 >> put a+ put (SExp_Int a ) = putWord8 1 >> put a+ put (SExp_Char a ) = putWord8 2 >> put a+ put (SExp_String a ) = putWord8 3 >> put a+ put (SExp_Integer a ) = putWord8 4 >> put a+ put (SExp_Dbg a ) = putWord8 5 >> put a+ get = do t <- getWord8+ case t of+ 0 -> liftM SExp_Var get+ 1 -> liftM SExp_Int get+ 2 -> liftM SExp_Char get+ 3 -> liftM SExp_String get+ 4 -> liftM SExp_Integer get+ 5 -> liftM SExp_Dbg get++instance Binary Alt where+ put (Alt_Alt a b) = {- putWord8 0 >> -} put a >> put b+ get = {- do t <- getWord8+ case t of+ 0 -> -} liftM2 Alt_Alt get get++instance Binary Pat where+ put (Pat_Con a ) = {- putWord8 0 >> -} put a+ get = {- do t <- getWord8+ case t of+ 0 -> -} liftM Pat_Con get++instance Binary RunPrim where+ put = putEnum+ get = getEnum++instance Binary RRef where+ put (RRef_Glb a b ) = putWord8 0 >> put a >> put b+ put (RRef_Loc a b ) = putWord8 1 >> put a >> put b+ put (RRef_LDf a b ) = putWord8 2 >> put a >> put b+ put (RRef_Tag a ) = putWord8 3 >> put a+ put (RRef_Fld a b ) = putWord8 4 >> put a >> put b+ put (RRef_Dbg a ) = putWord8 5 >> put a+ put (RRef_Mod a ) = putWord8 6 >> put a+ put (RRef_Imp a b ) = putWord8 7 >> put a >> put b+ put (RRef_Exp a b ) = putWord8 8 >> put a >> put b+ get = do t <- getWord8+ case t of+ 0 -> liftM2 RRef_Glb get get+ 1 -> liftM2 RRef_Loc get get+ 2 -> liftM2 RRef_LDf get get+ 3 -> liftM RRef_Tag get+ 4 -> liftM2 RRef_Fld get get+ 5 -> liftM RRef_Dbg get+ 6 -> liftM RRef_Mod get+ 7 -> liftM2 RRef_Imp get get+ 8 -> liftM2 RRef_Exp get get++instance Binary a => Binary (CRArray a) where+ put = put . crarrayToList+ get = fmap crarrayFromList get+++ -- ************************************** -- Construction: references -- **************************************@@ -222,12 +400,20 @@ mkLocDifRef :: Int -> Int -> RRef mkLocDifRef = RRef_LDf --- | 'RRef' to global from module, using module nr and offset+-- | 'RRef' to global from module, using module nr and offset (will become obsolete, replaced by either Imp or Mod Ref mkGlobRef :: Int -> Int -> RRef mkGlobRef = RRef_Glb +-- | 'RRef' to global from module, using module nr and offset+mkImpRef :: Int -> Int -> RRef+mkImpRef = RRef_Imp +-- | 'RRef' to global from current module, using offset+mkModRef :: Int -> RRef+mkModRef = RRef_Mod ++ -- ************************************** -- Construction: constants as SExp or Exp -- **************************************@@ -374,6 +560,18 @@ -- **************************************+-- Construction: Import+-- **************************************++-- | Meta: datatype constructor info+mkImport+ :: HsName -- ^ name of imported module+ -> Import+mkImport = Import_Import++++-- ************************************** -- Construction: Meta info -- ************************************** @@ -398,8 +596,20 @@ -- Construction: Top level module -- ************************************** +-- | Module, with imports, with meta info+mkModWithImportsMetas+ :: HsName -- ^ module name+ -> Int -- ^ module number+ -> Int -- ^ total stack size, including globals of module, their setup (see semantics), and the main startup part kicking of evaluation+ -> [Import] -- ^ imports+ -> [Meta] -- ^ meta info+ -> CRArray Bind -- ^ bound expressions+ -> Maybe Exp -- ^ body of main, absence of main indicated by Nothing+ -> Mod+mkModWithImportsMetas modNm modNr stkDepth imports metas binds body = Mod_Mod ref2nmEmpty modNm modNr stkDepth imports metas binds body+ -- | Module, with meta info-mkMod''+mkModWithMetas :: HsName -- ^ module name -> Int -- ^ module number -> Int -- ^ total stack size, including globals of module, their setup (see semantics), and the main startup part kicking of evaluation@@ -407,7 +617,7 @@ -> CRArray Bind -- ^ bound expressions -> Exp -- ^ body of main -> Mod-mkMod'' modNm modNr stkDepth metas binds body = Mod_Mod ref2nmEmpty modNm modNr stkDepth metas binds body+mkModWithMetas modNm modNr stkDepth metas binds body = mkModWithImportsMetas modNm modNr stkDepth [] metas binds (Just body) -- | Module mkMod'@@ -417,7 +627,7 @@ -> CRArray Bind -- ^ bound expressions -> Exp -- ^ body of main -> Mod-mkMod' modNm modNr stkDepth binds body = mkMod'' modNm modNr stkDepth [] binds body+mkMod' modNm modNr stkDepth binds body = mkModWithMetas modNm modNr stkDepth [] binds body -- | Module mkMod@@ -429,6 +639,8 @@ -> Mod mkMod modNm modNr stkDepth binds body = mkMod' modNm modNr stkDepth (crarrayFromList binds) body +-- AGItf -------------------------------------------------------+data AGItf = AGItf_AGItf {module_AGItf_AGItf :: !(Mod)} -- Alt --------------------------------------------------------- data Alt = Alt_Alt {ref2nm_Alt_Alt :: !(Ref2Nm),expr_Alt_Alt :: !(Exp)} -- DataCon -----------------------------------------------------@@ -445,15 +657,20 @@ | Exp_Tail {expr_Exp_Tail :: !(Exp)} | Exp_Case {expr_Exp_Case :: !(SExp),alts_Exp_Case :: !((CRArray Alt))} | Exp_FFI {prim_Exp_FFI :: !(RunPrim),args_Exp_FFI :: !((CRArray SExp))}+-- Import ------------------------------------------------------+data Import = Import_Import {nm_Import_Import :: !(HsName)}+-- ImportL -----------------------------------------------------+type ImportL = [Import]+-- MbExp -------------------------------------------------------+type MbExp = Maybe (Exp) -- Meta -------------------------------------------------------- data Meta = Meta_Data {tyNm_Meta_Data :: !(HsName),dataCons_Meta_Data :: !(DataConL)} -- MetaL ------------------------------------------------------- type MetaL = [Meta] -- Mod ----------------------------------------------------------data Mod = Mod_Mod {ref2nm_Mod_Mod :: !(Ref2Nm),moduleNm_Mod_Mod :: !(HsName),moduleNr_Mod_Mod :: !(Int),stkDepth_Mod_Mod :: !(Int),metas_Mod_Mod :: !(MetaL),binds_Mod_Mod :: !((CRArray Bind)),body_Mod_Mod :: !(Exp)}+data Mod = Mod_Mod {ref2nm_Mod_Mod :: !(Ref2Nm),moduleNm_Mod_Mod :: !(HsName),moduleNr_Mod_Mod :: !(Int),stkDepth_Mod_Mod :: !(Int),imports_Mod_Mod :: !(ImportL),metas_Mod_Mod :: !(MetaL),binds_Mod_Mod :: !((CRArray Bind)),mbbody_Mod_Mod :: !(MbExp)} -- Pat --------------------------------------------------------- data Pat = Pat_Con {tag_Pat_Con :: !(Int)}- | Pat_BoolExpr {expr_Pat_BoolExpr :: !(Exp)} -- SExp -------------------------------------------------------- data SExp = SExp_Var {ref_SExp_Var :: !(RRef)} | SExp_Int {int_SExp_Int :: !(Int)}
@@ -13,12 +13,13 @@ -- * CoreRun AST -- | The datatypes making up a CoreRun program. Mod- , Exp+ , Exp, MbExp , SExp , Alt -- , Pat , Bind , RRef+ , Import , Meta , DataCon @@ -31,6 +32,8 @@ , mkLocLevRef , mkLocDifRef , mkGlobRef+ , mkImpRef+ , mkModRef -- ** Expressions , mkExp@@ -55,7 +58,8 @@ , mkMetaDataCon, mkMetaDataType -- ** Modules- , mkMod, mkMod', mkMod''+ , mkMod, mkMod', mkModWithMetas, mkModWithImportsMetas+ , mkImport -- * Conversion , rrefToDif@@ -98,7 +102,7 @@ runCoreRunIO opts mod = do catch (runCoreRun opts [] mod $ cmodRun opts mod)- (\(e :: SomeException) -> hFlush stdout >> (return $ Left $ strMsg $ "cpRunCoreRun: " ++ show e))+ (\(e :: SomeException) -> hFlush stdout >> (return $ Left $ strMsg $ "runCoreRunIO: " ++ show e)) -- ************************************** -- Utilities (i.e. other stuff)
@@ -1,5 +1,4 @@ {-# LINE 2 "src/ehc/CoreRun/API/Internal.chs" #-}- -- | CoreRun Internal API -- -- Intended for implementing stuff that has to know about internals (i.e. class instances).@@ -14,12 +13,14 @@ ( -- * CoreRun AST -- | The datatypes making up a CoreRun program, with constructors- Mod(..)+ AGItf(..)+ , Mod(..) , Exp(..) , SExp(..) , Alt(..) , Pat(..) , DataCon(..)+ , Import(..) , Meta(..) , RRef(..)
@@ -0,0 +1,531 @@+++-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/CoreRun/Check.)+module UHC.Light.Compiler.CoreRun.Check(crmodCheck', Inh_AGItf (..), Syn_AGItf (..)) where++import UHC.Light.Compiler.Base.Common+import UHC.Light.Compiler.Opts+import UHC.Light.Compiler.Error+import UHC.Light.Compiler.CoreRun+import qualified UHC.Util.Rel as Rel+import qualified UHC.Light.Compiler.Module.ImportExport as ModImpExp+++++++++++++crmodCheck'+ :: Inh_AGItf+ -> Mod+ -> Syn_AGItf+crmodCheck' inh crmod+ = t+ where t = wrap_AGItf+ (sem_AGItf (AGItf_AGItf crmod))+ inh+++-- AGItf -------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ moduleNm : HsName+ opts : EHCOpts+ synthesized attributes:+ hasMain : Bool+ impModNmL : [HsName]+ mod : ModImpExp.Mod+ realModuleNm : HsName+ alternatives:+ alternative AGItf:+ child module : Mod +-}+-- cata+sem_AGItf :: AGItf ->+ T_AGItf+sem_AGItf (AGItf_AGItf _module) =+ (sem_AGItf_AGItf (sem_Mod _module))+-- semantic domain+type T_AGItf = HsName ->+ EHCOpts ->+ ( Bool,([HsName]),(ModImpExp.Mod),HsName)+data Inh_AGItf = Inh_AGItf {moduleNm_Inh_AGItf :: !(HsName),opts_Inh_AGItf :: !(EHCOpts)}+data Syn_AGItf = Syn_AGItf {hasMain_Syn_AGItf :: !(Bool),impModNmL_Syn_AGItf :: !(([HsName])),mod_Syn_AGItf :: !((ModImpExp.Mod)),realModuleNm_Syn_AGItf :: !(HsName)}+wrap_AGItf :: T_AGItf ->+ Inh_AGItf ->+ Syn_AGItf+wrap_AGItf sem (Inh_AGItf _lhsImoduleNm _lhsIopts) =+ (let ( _lhsOhasMain,_lhsOimpModNmL,_lhsOmod,_lhsOrealModuleNm) = sem _lhsImoduleNm _lhsIopts+ in (Syn_AGItf _lhsOhasMain _lhsOimpModNmL _lhsOmod _lhsOrealModuleNm))+sem_AGItf_AGItf :: T_Mod ->+ T_AGItf+sem_AGItf_AGItf module_ =+ (\ _lhsImoduleNm+ _lhsIopts ->+ (case (_lhsIopts) of+ { _moduleOopts ->+ (case (_lhsImoduleNm) of+ { _moduleOmoduleNm ->+ (case (module_ _moduleOmoduleNm _moduleOopts) of+ { ( _moduleIhasMain,_moduleIimpModNmL,_moduleImod,_moduleIrealModuleNm) ->+ (case (_moduleIhasMain) of+ { _lhsOhasMain ->+ (case (_moduleIimpModNmL) of+ { _lhsOimpModNmL ->+ (case (_moduleImod) of+ { _lhsOmod ->+ (case (_moduleIrealModuleNm) of+ { _lhsOrealModuleNm ->+ ( _lhsOhasMain,_lhsOimpModNmL,_lhsOmod,_lhsOrealModuleNm) }) }) }) }) }) }) }))+-- Alt ---------------------------------------------------------+{-+ alternatives:+ alternative Alt:+ child ref2nm : {Ref2Nm}+ child expr : Exp +-}+-- cata+sem_Alt :: Alt ->+ T_Alt+sem_Alt (Alt_Alt _ref2nm _expr) =+ (sem_Alt_Alt _ref2nm (sem_Exp _expr))+-- semantic domain+type T_Alt = ( )+sem_Alt_Alt :: Ref2Nm ->+ T_Exp ->+ T_Alt+sem_Alt_Alt ref2nm_ expr_ =+ ( )+-- DataCon -----------------------------------------------------+{-+ alternatives:+ alternative Con:+ child conNm : {HsName}+ child tagNr : {Int}+-}+-- cata+sem_DataCon :: DataCon ->+ T_DataCon+sem_DataCon (DataCon_Con _conNm _tagNr) =+ (sem_DataCon_Con _conNm _tagNr)+-- semantic domain+type T_DataCon = ( )+sem_DataCon_Con :: HsName ->+ Int ->+ T_DataCon+sem_DataCon_Con conNm_ tagNr_ =+ ( )+-- DataConL ----------------------------------------------------+{-+ alternatives:+ alternative Cons:+ child hd : DataCon + child tl : DataConL + alternative Nil:+-}+-- cata+sem_DataConL :: DataConL ->+ T_DataConL+sem_DataConL list =+ (Prelude.foldr sem_DataConL_Cons sem_DataConL_Nil (Prelude.map sem_DataCon list))+-- semantic domain+type T_DataConL = ( )+sem_DataConL_Cons :: T_DataCon ->+ T_DataConL ->+ T_DataConL+sem_DataConL_Cons hd_ tl_ =+ ( )+sem_DataConL_Nil :: T_DataConL+sem_DataConL_Nil =+ ( )+-- Exp ---------------------------------------------------------+{-+ alternatives:+ alternative SExp:+ child sexpr : SExp + alternative Tup:+ child tag : {Int}+ child args : {CRArray SExp}+ alternative Let:+ child firstOff : {Int}+ child ref2nm : {Ref2Nm}+ child binds : {CRArray Bind}+ child body : Exp + alternative App:+ child func : Exp + child args : {CRArray SExp}+ alternative Lam:+ child mbNm : {Maybe HsName}+ child nrArgs : {Int}+ child stkDepth : {Int}+ child ref2nm : {Ref2Nm}+ child body : Exp + alternative Force:+ child expr : Exp + alternative Tail:+ child expr : Exp + alternative Case:+ child expr : SExp + child alts : {CRArray Alt}+ alternative FFI:+ child prim : {RunPrim}+ child args : {CRArray SExp}+-}+-- cata+sem_Exp :: Exp ->+ T_Exp+sem_Exp (Exp_SExp _sexpr) =+ (sem_Exp_SExp (sem_SExp _sexpr))+sem_Exp (Exp_Tup _tag _args) =+ (sem_Exp_Tup _tag _args)+sem_Exp (Exp_Let _firstOff _ref2nm _binds _body) =+ (sem_Exp_Let _firstOff _ref2nm _binds (sem_Exp _body))+sem_Exp (Exp_App _func _args) =+ (sem_Exp_App (sem_Exp _func) _args)+sem_Exp (Exp_Lam _mbNm _nrArgs _stkDepth _ref2nm _body) =+ (sem_Exp_Lam _mbNm _nrArgs _stkDepth _ref2nm (sem_Exp _body))+sem_Exp (Exp_Force _expr) =+ (sem_Exp_Force (sem_Exp _expr))+sem_Exp (Exp_Tail _expr) =+ (sem_Exp_Tail (sem_Exp _expr))+sem_Exp (Exp_Case _expr _alts) =+ (sem_Exp_Case (sem_SExp _expr) _alts)+sem_Exp (Exp_FFI _prim _args) =+ (sem_Exp_FFI _prim _args)+-- semantic domain+type T_Exp = ( )+sem_Exp_SExp :: T_SExp ->+ T_Exp+sem_Exp_SExp sexpr_ =+ ( )+sem_Exp_Tup :: Int ->+ (CRArray SExp) ->+ T_Exp+sem_Exp_Tup tag_ args_ =+ ( )+sem_Exp_Let :: Int ->+ Ref2Nm ->+ (CRArray Bind) ->+ T_Exp ->+ T_Exp+sem_Exp_Let firstOff_ ref2nm_ binds_ body_ =+ ( )+sem_Exp_App :: T_Exp ->+ (CRArray SExp) ->+ T_Exp+sem_Exp_App func_ args_ =+ ( )+sem_Exp_Lam :: (Maybe HsName) ->+ Int ->+ Int ->+ Ref2Nm ->+ T_Exp ->+ T_Exp+sem_Exp_Lam mbNm_ nrArgs_ stkDepth_ ref2nm_ body_ =+ ( )+sem_Exp_Force :: T_Exp ->+ T_Exp+sem_Exp_Force expr_ =+ ( )+sem_Exp_Tail :: T_Exp ->+ T_Exp+sem_Exp_Tail expr_ =+ ( )+sem_Exp_Case :: T_SExp ->+ (CRArray Alt) ->+ T_Exp+sem_Exp_Case expr_ alts_ =+ ( )+sem_Exp_FFI :: RunPrim ->+ (CRArray SExp) ->+ T_Exp+sem_Exp_FFI prim_ args_ =+ ( )+-- Import ------------------------------------------------------+{-+ visit 0:+ synthesized attributes:+ impModNmL : [HsName]+ modImpL : [ModImpExp.ModImp]+ alternatives:+ alternative Import:+ child nm : {HsName}+-}+-- cata+sem_Import :: Import ->+ T_Import+sem_Import (Import_Import _nm) =+ (sem_Import_Import _nm)+-- semantic domain+type T_Import = ( ([HsName]),([ModImpExp.ModImp]))+sem_Import_Import :: HsName ->+ T_Import+sem_Import_Import nm_ =+ (case ([nm_]) of+ { _lhsOimpModNmL ->+ (case ([ModImpExp.ModImp True nm_ nm_ False [] emptyRange]) of+ { _lhsOmodImpL ->+ ( _lhsOimpModNmL,_lhsOmodImpL) }) })+-- ImportL -----------------------------------------------------+{-+ visit 0:+ synthesized attributes:+ impModNmL : [HsName]+ modImpL : [ModImpExp.ModImp]+ alternatives:+ alternative Cons:+ child hd : Import + child tl : ImportL + alternative Nil:+-}+-- cata+sem_ImportL :: ImportL ->+ T_ImportL+sem_ImportL list =+ (Prelude.foldr sem_ImportL_Cons sem_ImportL_Nil (Prelude.map sem_Import list))+-- semantic domain+type T_ImportL = ( ([HsName]),([ModImpExp.ModImp]))+sem_ImportL_Cons :: T_Import ->+ T_ImportL ->+ T_ImportL+sem_ImportL_Cons hd_ tl_ =+ (case (tl_) of+ { ( _tlIimpModNmL,_tlImodImpL) ->+ (case (hd_) of+ { ( _hdIimpModNmL,_hdImodImpL) ->+ (case (_hdIimpModNmL ++ _tlIimpModNmL) of+ { _lhsOimpModNmL ->+ (case (_hdImodImpL ++ _tlImodImpL) of+ { _lhsOmodImpL ->+ ( _lhsOimpModNmL,_lhsOmodImpL) }) }) }) })+sem_ImportL_Nil :: T_ImportL+sem_ImportL_Nil =+ (case ([]) of+ { _lhsOimpModNmL ->+ (case ([]) of+ { _lhsOmodImpL ->+ ( _lhsOimpModNmL,_lhsOmodImpL) }) })+-- MbExp -------------------------------------------------------+{-+ visit 0:+ inherited attribute:+ opts : EHCOpts+ synthesized attribute:+ isJust : Bool+ alternatives:+ alternative Just:+ child just : Exp + alternative Nothing:+-}+-- cata+sem_MbExp :: MbExp ->+ T_MbExp+sem_MbExp (Prelude.Just x) =+ (sem_MbExp_Just (sem_Exp x))+sem_MbExp Prelude.Nothing =+ sem_MbExp_Nothing+-- semantic domain+type T_MbExp = EHCOpts ->+ ( Bool)+sem_MbExp_Just :: T_Exp ->+ T_MbExp+sem_MbExp_Just just_ =+ (\ _lhsIopts ->+ (case (True) of+ { _lhsOisJust ->+ ( _lhsOisJust) }))+sem_MbExp_Nothing :: T_MbExp+sem_MbExp_Nothing =+ (\ _lhsIopts ->+ (case (False) of+ { _lhsOisJust ->+ ( _lhsOisJust) }))+-- Meta --------------------------------------------------------+{-+ alternatives:+ alternative Data:+ child tyNm : {HsName}+ child dataCons : DataConL +-}+-- cata+sem_Meta :: Meta ->+ T_Meta+sem_Meta (Meta_Data _tyNm _dataCons) =+ (sem_Meta_Data _tyNm (sem_DataConL _dataCons))+-- semantic domain+type T_Meta = ( )+sem_Meta_Data :: HsName ->+ T_DataConL ->+ T_Meta+sem_Meta_Data tyNm_ dataCons_ =+ ( )+-- MetaL -------------------------------------------------------+{-+ alternatives:+ alternative Cons:+ child hd : Meta + child tl : MetaL + alternative Nil:+-}+-- cata+sem_MetaL :: MetaL ->+ T_MetaL+sem_MetaL list =+ (Prelude.foldr sem_MetaL_Cons sem_MetaL_Nil (Prelude.map sem_Meta list))+-- semantic domain+type T_MetaL = ( )+sem_MetaL_Cons :: T_Meta ->+ T_MetaL ->+ T_MetaL+sem_MetaL_Cons hd_ tl_ =+ ( )+sem_MetaL_Nil :: T_MetaL+sem_MetaL_Nil =+ ( )+-- Mod ---------------------------------------------------------+{-+ visit 0:+ inherited attributes:+ moduleNm : HsName+ opts : EHCOpts+ synthesized attributes:+ hasMain : Bool+ impModNmL : [HsName]+ mod : ModImpExp.Mod+ realModuleNm : HsName+ alternatives:+ alternative Mod:+ child ref2nm : {Ref2Nm}+ child moduleNm : {HsName}+ child moduleNr : {Int}+ child stkDepth : {Int}+ child imports : ImportL + child metas : MetaL + child binds : {CRArray Bind}+ child mbbody : MbExp + visit 0:+ local realModuleNm : _+-}+-- cata+sem_Mod :: Mod ->+ T_Mod+sem_Mod (Mod_Mod _ref2nm _moduleNm _moduleNr _stkDepth _imports _metas _binds _mbbody) =+ (sem_Mod_Mod _ref2nm _moduleNm _moduleNr _stkDepth (sem_ImportL _imports) (sem_MetaL _metas) _binds (sem_MbExp _mbbody))+-- semantic domain+type T_Mod = HsName ->+ EHCOpts ->+ ( Bool,([HsName]),(ModImpExp.Mod),HsName)+sem_Mod_Mod :: Ref2Nm ->+ HsName ->+ Int ->+ Int ->+ T_ImportL ->+ T_MetaL ->+ (CRArray Bind) ->+ T_MbExp ->+ T_Mod+sem_Mod_Mod ref2nm_ moduleNm_ moduleNr_ stkDepth_ imports_ metas_ binds_ mbbody_ =+ (\ _lhsImoduleNm+ _lhsIopts ->+ (case (_lhsIopts) of+ { _mbbodyOopts ->+ (case (mbbody_ _mbbodyOopts) of+ { ( _mbbodyIisJust) ->+ (case (_mbbodyIisJust) of+ { _lhsOhasMain ->+ (case (imports_) of+ { ( _importsIimpModNmL,_importsImodImpL) ->+ (case (_importsIimpModNmL) of+ { _lhsOimpModNmL ->+ (case (moduleNm_) of+ { _realModuleNm ->+ (case (ModImpExp.Mod+ _realModuleNm (Just _realModuleNm) Nothing _importsImodImpL+ Rel.empty+ Rel.empty+ []) of+ { _lhsOmod ->+ (case (_realModuleNm) of+ { _lhsOrealModuleNm ->+ ( _lhsOhasMain,_lhsOimpModNmL,_lhsOmod,_lhsOrealModuleNm) }) }) }) }) }) }) }) }))+-- Pat ---------------------------------------------------------+{-+ alternatives:+ alternative Con:+ child tag : {Int}+-}+-- cata+sem_Pat :: Pat ->+ T_Pat+sem_Pat (Pat_Con _tag) =+ (sem_Pat_Con _tag)+-- semantic domain+type T_Pat = ( )+sem_Pat_Con :: Int ->+ T_Pat+sem_Pat_Con tag_ =+ ( )+-- SExp --------------------------------------------------------+{-+ alternatives:+ alternative Var:+ child ref : {RRef}+ alternative Int:+ child int : {Int}+ alternative Char:+ child char : {Char}+ alternative String:+ child str : {String}+ alternative Integer:+ child integer : {Integer}+ alternative Dbg:+ child msg : {String}+-}+-- cata+sem_SExp :: SExp ->+ T_SExp+sem_SExp (SExp_Var _ref) =+ (sem_SExp_Var _ref)+sem_SExp (SExp_Int _int) =+ (sem_SExp_Int _int)+sem_SExp (SExp_Char _char) =+ (sem_SExp_Char _char)+sem_SExp (SExp_String _str) =+ (sem_SExp_String _str)+sem_SExp (SExp_Integer _integer) =+ (sem_SExp_Integer _integer)+sem_SExp (SExp_Dbg _msg) =+ (sem_SExp_Dbg _msg)+-- semantic domain+type T_SExp = ( )+sem_SExp_Var :: RRef ->+ T_SExp+sem_SExp_Var ref_ =+ ( )+sem_SExp_Int :: Int ->+ T_SExp+sem_SExp_Int int_ =+ ( )+sem_SExp_Char :: Char ->+ T_SExp+sem_SExp_Char char_ =+ ( )+sem_SExp_String :: String ->+ T_SExp+sem_SExp_String str_ =+ ( )+sem_SExp_Integer :: Integer ->+ T_SExp+sem_SExp_Integer integer_ =+ ( )+sem_SExp_Dbg :: String ->+ T_SExp+sem_SExp_Dbg msg_ =+ ( )
@@ -30,11 +30,17 @@ -- | Parse module 'Mod' pMod :: CRParser Mod pMod- = (\nm nr sz main ms bs -> mkMod'' nm nr sz ms (crarrayFromList bs) main)- <$ pMODULE <*> pMaybe (mkHNm "Main") id pDollNm <*> pInt <* pCOMMA <*> pInt <* pRARROW <*> pExp <* pSEMI+ = (\nm nr sz main is ms bs -> mkModWithImportsMetas nm nr sz is ms (crarrayFromList bs) main)+ <$ pMODULE <*> pMaybe (mkHNm "Main") id pDollNm <*> pInt <* pCOMMA <*> pInt <*> pMb (pRARROW *> pExp) <* pSEMI+ <*> pList (pImport <* pSEMI) <*> pList (pMeta <* pSEMI) <*> pList (pExp <* pSEMI) +-- | Parse 'Import'+pImport :: CRParser Import+pImport+ = Import_Import <$ pIMPORT <*> pDollNm+ -- | Parse 'Meta' pMeta :: CRParser Meta pMeta@@ -73,10 +79,14 @@ pRRef :: CRParser RRef pRRef = (\b sufs -> foldl (flip ($)) b sufs) <$> pB <*> pList_ng pS- where pB = ( mkLocDifRef <$ pKeyTk "d"- <|> mkGlobRef <$ pKeyTk "g"- <|> mkLocLevRef <$ pKeyTk "l"- ) <* pDOT <*> pInt <* pDOT <*> pInt+ where pB = ( ( mkLocDifRef <$ pKeyTk "d"+ <|> mkGlobRef <$ pKeyTk "g"+ <|> mkImpRef <$ pKeyTk "i"+ <|> mkLocLevRef <$ pKeyTk "l"+ ) <* pDOT <*> pInt <* pDOT <*> pInt+ )+ <|> ( mkModRef <$ pKeyTk "m" <* pDOT <*> pInt+ ) pS = pDOT *> ( RRef_Tag <$ pKeyTk "tag" <|> flip RRef_Fld <$> pInt
@@ -51,7 +51,7 @@ -- | PP using InhPP ppRRef :: InhPP -> RRef -> PP_Doc-ppRRef inhpp r = ppMbPost ppCurly (r2nInhPP inhpp r) r+ppRRef inhpp r = ppMbPost ppCurly (ref2nmLookup r $ r2nInhPP inhpp) r @@ -130,6 +130,9 @@ instance PP RRef where pp (RRef_Glb m e) = ppDots [pp "g", pp m, pp e]+ pp (RRef_Imp m e) = ppDots [pp "i", pp m, pp e]+ pp (RRef_Exp m e) = ppDots [pp m, pp e]+ pp (RRef_Mod e ) = ppDots [pp "m", pp e] pp (RRef_Loc l e) = ppDots [pp "l", pp l, pp e] pp (RRef_LDf l e) = ppDots [pp "d", pp l, pp e] pp (RRef_Tag r ) = ppDots [pp r, pp "tag"]@@ -147,6 +150,23 @@ ppBinds'' :: InhPP -> (Int -> RRef) -> Int -> CRArray Bind -> PP_Doc ppBinds'' inhpp mkr off bs = ppBinds''' inhpp (ppRRef inhpp . mkr) off [ (i, ppExp'' inhpp e) | (i,e) <- craAssocs bs ] +-- AGItf -------------------------------------------------------+{-+ alternatives:+ alternative AGItf:+ child module : Mod +-}+-- cata+sem_AGItf :: AGItf ->+ T_AGItf+sem_AGItf (AGItf_AGItf _module) =+ (sem_AGItf_AGItf (sem_Mod _module))+-- semantic domain+type T_AGItf = ( )+sem_AGItf_AGItf :: T_Mod ->+ T_AGItf+sem_AGItf_AGItf module_ =+ ( ) -- Alt --------------------------------------------------------- {- visit 0:@@ -194,6 +214,8 @@ -- DataCon ----------------------------------------------------- {- visit 0:+ inherited attribute:+ inhpp : InhPP synthesized attribute: pp : PP_Doc alternatives:@@ -207,17 +229,21 @@ sem_DataCon (DataCon_Con _conNm _tagNr) = (sem_DataCon_Con _conNm _tagNr) -- semantic domain-type T_DataCon = ( PP_Doc)+type T_DataCon = InhPP ->+ ( PP_Doc) sem_DataCon_Con :: HsName -> Int -> T_DataCon sem_DataCon_Con conNm_ tagNr_ =- (case (ppDifficultNm conNm_ >#< "->" >#< tagNr_) of- { _lhsOpp ->- ( _lhsOpp) })+ (\ _lhsIinhpp ->+ (case (ppDifficultNm conNm_ >#< "->" >#< tagNr_) of+ { _lhsOpp ->+ ( _lhsOpp) })) -- DataConL ---------------------------------------------------- {- visit 0:+ inherited attribute:+ inhpp : InhPP synthesized attributes: pp : PP_Doc ppL : [PP_Doc]@@ -233,27 +259,34 @@ sem_DataConL list = (Prelude.foldr sem_DataConL_Cons sem_DataConL_Nil (Prelude.map sem_DataCon list)) -- semantic domain-type T_DataConL = ( PP_Doc,([PP_Doc]))+type T_DataConL = InhPP ->+ ( PP_Doc,([PP_Doc])) sem_DataConL_Cons :: T_DataCon -> T_DataConL -> T_DataConL sem_DataConL_Cons hd_ tl_ =- (case (tl_) of- { ( _tlIpp,_tlIppL) ->- (case (hd_) of- { ( _hdIpp) ->- (case (_hdIpp >-< _tlIpp) of- { _lhsOpp ->- (case (_hdIpp : _tlIppL) of- { _lhsOppL ->- ( _lhsOpp,_lhsOppL) }) }) }) })+ (\ _lhsIinhpp ->+ (case (_lhsIinhpp) of+ { _tlOinhpp ->+ (case (tl_ _tlOinhpp) of+ { ( _tlIpp,_tlIppL) ->+ (case (_lhsIinhpp) of+ { _hdOinhpp ->+ (case (hd_ _hdOinhpp) of+ { ( _hdIpp) ->+ (case (_hdIpp >-< _tlIpp) of+ { _lhsOpp ->+ (case (_hdIpp : _tlIppL) of+ { _lhsOppL ->+ ( _lhsOpp,_lhsOppL) }) }) }) }) }) })) sem_DataConL_Nil :: T_DataConL sem_DataConL_Nil =- (case (empty) of- { _lhsOpp ->- (case ([]) of- { _lhsOppL ->- ( _lhsOpp,_lhsOppL) }) })+ (\ _lhsIinhpp ->+ (case (empty) of+ { _lhsOpp ->+ (case ([]) of+ { _lhsOppL ->+ ( _lhsOpp,_lhsOppL) }) })) -- Exp --------------------------------------------------------- {- visit 0:@@ -434,9 +467,129 @@ (case ("ffi" >#< show (showRunPrim prim_) >|< ppParensCommas (map (ppSExp'' _lhsIinhpp) $ V.toList args_)) of { _lhsOpp -> ( _lhsOpp) }))+-- Import ------------------------------------------------------+{-+ visit 0:+ inherited attribute:+ inhpp : InhPP+ synthesized attribute:+ pp : PP_Doc+ alternatives:+ alternative Import:+ child nm : {HsName}+-}+-- cata+sem_Import :: Import ->+ T_Import+sem_Import (Import_Import _nm) =+ (sem_Import_Import _nm)+-- semantic domain+type T_Import = InhPP ->+ ( PP_Doc)+sem_Import_Import :: HsName ->+ T_Import+sem_Import_Import nm_ =+ (\ _lhsIinhpp ->+ (case ("import" >#< ppCoreNm nm_) of+ { _lhsOpp ->+ ( _lhsOpp) }))+-- ImportL -----------------------------------------------------+{-+ visit 0:+ inherited attribute:+ inhpp : InhPP+ synthesized attributes:+ pp : PP_Doc+ ppL : [PP_Doc]+ alternatives:+ alternative Cons:+ child hd : Import + child tl : ImportL + alternative Nil:+-}+-- cata+sem_ImportL :: ImportL ->+ T_ImportL+sem_ImportL list =+ (Prelude.foldr sem_ImportL_Cons sem_ImportL_Nil (Prelude.map sem_Import list))+-- semantic domain+type T_ImportL = InhPP ->+ ( PP_Doc,([PP_Doc]))+sem_ImportL_Cons :: T_Import ->+ T_ImportL ->+ T_ImportL+sem_ImportL_Cons hd_ tl_ =+ (\ _lhsIinhpp ->+ (case (_lhsIinhpp) of+ { _tlOinhpp ->+ (case (tl_ _tlOinhpp) of+ { ( _tlIpp,_tlIppL) ->+ (case (_lhsIinhpp) of+ { _hdOinhpp ->+ (case (hd_ _hdOinhpp) of+ { ( _hdIpp) ->+ (case (_hdIpp >-< _tlIpp) of+ { _lhsOpp ->+ (case (_hdIpp : _tlIppL) of+ { _lhsOppL ->+ ( _lhsOpp,_lhsOppL) }) }) }) }) }) }))+sem_ImportL_Nil :: T_ImportL+sem_ImportL_Nil =+ (\ _lhsIinhpp ->+ (case (empty) of+ { _lhsOpp ->+ (case ([]) of+ { _lhsOppL ->+ ( _lhsOpp,_lhsOppL) }) }))+-- MbExp -------------------------------------------------------+{-+ visit 0:+ inherited attribute:+ inhpp : InhPP+ synthesized attributes:+ pp : PP_Doc+ ppMb : Maybe PP_Doc+ alternatives:+ alternative Just:+ child just : Exp + alternative Nothing:+-}+-- cata+sem_MbExp :: MbExp ->+ T_MbExp+sem_MbExp (Prelude.Just x) =+ (sem_MbExp_Just (sem_Exp x))+sem_MbExp Prelude.Nothing =+ sem_MbExp_Nothing+-- semantic domain+type T_MbExp = InhPP ->+ ( PP_Doc,(Maybe PP_Doc))+sem_MbExp_Just :: T_Exp ->+ T_MbExp+sem_MbExp_Just just_ =+ (\ _lhsIinhpp ->+ (case (_lhsIinhpp) of+ { _justOinhpp ->+ (case (just_ _justOinhpp) of+ { ( _justIpp) ->+ (case (_justIpp) of+ { _lhsOpp ->+ (case (Just _justIpp) of+ { _lhsOppMb ->+ ( _lhsOpp,_lhsOppMb) }) }) }) }))+sem_MbExp_Nothing :: T_MbExp+sem_MbExp_Nothing =+ (\ _lhsIinhpp ->+ (case (empty) of+ { _lhsOpp ->+ (case (Nothing) of+ { _lhsOppMb ->+ ( _lhsOpp,_lhsOppMb) }) })) -- Meta -------------------------------------------------------- {- visit 0:+ inherited attribute:+ inhpp : InhPP synthesized attribute: pp : PP_Doc alternatives:@@ -450,19 +603,25 @@ sem_Meta (Meta_Data _tyNm _dataCons) = (sem_Meta_Data _tyNm (sem_DataConL _dataCons)) -- semantic domain-type T_Meta = ( PP_Doc)+type T_Meta = InhPP ->+ ( PP_Doc) sem_Meta_Data :: HsName -> T_DataConL -> T_Meta sem_Meta_Data tyNm_ dataCons_ =- (case (dataCons_) of- { ( _dataConsIpp,_dataConsIppL) ->- (case ("data" >#< ppDifficultNm tyNm_ >#< "=" >#< ppBlockWithStringsH "" "" ", " _dataConsIppL) of- { _lhsOpp ->- ( _lhsOpp) }) })+ (\ _lhsIinhpp ->+ (case (_lhsIinhpp) of+ { _dataConsOinhpp ->+ (case (dataCons_ _dataConsOinhpp) of+ { ( _dataConsIpp,_dataConsIppL) ->+ (case ("data" >#< ppDifficultNm tyNm_ >#< "=" >#< ppBlockWithStringsH "" "" ", " _dataConsIppL) of+ { _lhsOpp ->+ ( _lhsOpp) }) }) })) -- MetaL ------------------------------------------------------- {- visit 0:+ inherited attribute:+ inhpp : InhPP synthesized attributes: pp : PP_Doc ppL : [PP_Doc]@@ -478,27 +637,34 @@ sem_MetaL list = (Prelude.foldr sem_MetaL_Cons sem_MetaL_Nil (Prelude.map sem_Meta list)) -- semantic domain-type T_MetaL = ( PP_Doc,([PP_Doc]))+type T_MetaL = InhPP ->+ ( PP_Doc,([PP_Doc])) sem_MetaL_Cons :: T_Meta -> T_MetaL -> T_MetaL sem_MetaL_Cons hd_ tl_ =- (case (tl_) of- { ( _tlIpp,_tlIppL) ->- (case (hd_) of- { ( _hdIpp) ->- (case (_hdIpp >-< _tlIpp) of- { _lhsOpp ->- (case (_hdIpp : _tlIppL) of- { _lhsOppL ->- ( _lhsOpp,_lhsOppL) }) }) }) })+ (\ _lhsIinhpp ->+ (case (_lhsIinhpp) of+ { _tlOinhpp ->+ (case (tl_ _tlOinhpp) of+ { ( _tlIpp,_tlIppL) ->+ (case (_lhsIinhpp) of+ { _hdOinhpp ->+ (case (hd_ _hdOinhpp) of+ { ( _hdIpp) ->+ (case (_hdIpp >-< _tlIpp) of+ { _lhsOpp ->+ (case (_hdIpp : _tlIppL) of+ { _lhsOppL ->+ ( _lhsOpp,_lhsOppL) }) }) }) }) }) })) sem_MetaL_Nil :: T_MetaL sem_MetaL_Nil =- (case (empty) of- { _lhsOpp ->- (case ([]) of- { _lhsOppL ->- ( _lhsOpp,_lhsOppL) }) })+ (\ _lhsIinhpp ->+ (case (empty) of+ { _lhsOpp ->+ (case ([]) of+ { _lhsOppL ->+ ( _lhsOpp,_lhsOppL) }) })) -- Mod --------------------------------------------------------- {- visit 0:@@ -512,17 +678,18 @@ child moduleNm : {HsName} child moduleNr : {Int} child stkDepth : {Int}+ child imports : ImportL child metas : MetaL child binds : {CRArray Bind}- child body : Exp + child mbbody : MbExp visit 0: local inhpp : _ -} -- cata sem_Mod :: Mod -> T_Mod-sem_Mod (Mod_Mod _ref2nm _moduleNm _moduleNr _stkDepth _metas _binds _body) =- (sem_Mod_Mod _ref2nm _moduleNm _moduleNr _stkDepth (sem_MetaL _metas) _binds (sem_Exp _body))+sem_Mod (Mod_Mod _ref2nm _moduleNm _moduleNr _stkDepth _imports _metas _binds _mbbody) =+ (sem_Mod_Mod _ref2nm _moduleNm _moduleNr _stkDepth (sem_ImportL _imports) (sem_MetaL _metas) _binds (sem_MbExp _mbbody)) -- semantic domain type T_Mod = InhPP -> ( PP_Doc)@@ -538,25 +705,33 @@ HsName -> Int -> Int ->+ T_ImportL -> T_MetaL -> (CRArray Bind) ->- T_Exp ->+ T_MbExp -> T_Mod-sem_Mod_Mod ref2nm_ moduleNm_ moduleNr_ stkDepth_ metas_ binds_ body_ =+sem_Mod_Mod ref2nm_ moduleNm_ moduleNr_ stkDepth_ imports_ metas_ binds_ mbbody_ = (\ _lhsIinhpp -> (case (r2nAdd ref2nm_ _lhsIinhpp) of { _inhpp -> (case (_inhpp) of- { _bodyOinhpp ->- (case (body_ _bodyOinhpp) of- { ( _bodyIpp) ->- (case (metas_) of- { ( _metasIpp,_metasIppL) ->- (case ((ppSemi $ "module" >#< ppCoreNm moduleNm_ >#< ppCommas [moduleNr_, stkDepth_] >#< "->" >#< _bodyIpp)- >-< ppBindItems _metasIppL- >-< ppBinds'' _inhpp (RRef_Glb moduleNr_) 0 binds_) of- { _lhsOpp ->- ( _lhsOpp) }) }) }) }) }))+ { _mbbodyOinhpp ->+ (case (mbbody_ _mbbodyOinhpp) of+ { ( _mbbodyIpp,_mbbodyIppMb) ->+ (case (_inhpp) of+ { _metasOinhpp ->+ (case (metas_ _metasOinhpp) of+ { ( _metasIpp,_metasIppL) ->+ (case (_inhpp) of+ { _importsOinhpp ->+ (case (imports_ _importsOinhpp) of+ { ( _importsIpp,_importsIppL) ->+ (case ((ppSemi $ "module" >#< ppCoreNm moduleNm_ >#< ppCommas [moduleNr_, stkDepth_] >|< maybe empty (" ->" >#<) _mbbodyIppMb)+ >-< ppBindItems _importsIppL+ >-< ppBindItems _metasIppL+ >-< ppBinds'' _inhpp (RRef_Glb moduleNr_) 0 binds_) of+ { _lhsOpp ->+ ( _lhsOpp) }) }) }) }) }) }) }) })) -- Pat --------------------------------------------------------- {- visit 0:@@ -567,16 +742,12 @@ alternatives: alternative Con: child tag : {Int}- alternative BoolExpr:- child expr : Exp -} -- cata sem_Pat :: Pat -> T_Pat sem_Pat (Pat_Con _tag) = (sem_Pat_Con _tag)-sem_Pat (Pat_BoolExpr _expr) =- (sem_Pat_BoolExpr (sem_Exp _expr)) -- semantic domain type T_Pat = InhPP -> ( PP_Doc)@@ -587,17 +758,6 @@ (case (pp tag_) of { _lhsOpp -> ( _lhsOpp) }))-sem_Pat_BoolExpr :: T_Exp ->- T_Pat-sem_Pat_BoolExpr expr_ =- (\ _lhsIinhpp ->- (case (_lhsIinhpp) of- { _exprOinhpp ->- (case (expr_ _exprOinhpp) of- { ( _exprIpp) ->- (case (_exprIpp) of- { _lhsOpp ->- ( _lhsOpp) }) }) })) -- SExp -------------------------------------------------------- {- visit 0:
@@ -45,6 +45,19 @@ | RP_primGeInt | RP_primGtInt + | RP_primAndInt+ | RP_primOrInt+ | RP_primXorInt+ | RP_primComplementInt+ | RP_primShiftLeftInt+ | RP_primShiftRightInt+ | RP_primRotateLeftInt+ | RP_primRotateRightInt+ | RP_primBitSize+ | RP_primBitSizeMaybe+ | RP_primPopCount+ | RP_primBit+ | RP_primIntToInteger | RP_primIntegerToInt @@ -94,7 +107,7 @@ --- ** Standard handles - -- | Three handles are allocated during program initialisation,+ --- | Three handles are allocated during program initialisation, -- and are initially open. | RP_stdin@@ -105,7 +118,7 @@ --- ** Opening files - -- | RP_withFile+ --- | RP_withFile | RP_openFile -- :: FilePath -> IOMode -> IO Handle -- IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode), @@ -117,9 +130,9 @@ -- | These functions are also exported by the "Prelude". - -- | RP_readFile -- :: FilePath -> IO String- -- | RP_writeFile -- :: FilePath -> String -> IO ()- -- | RP_appendFile -- :: FilePath -> String -> IO ()+ --- | RP_readFile -- :: FilePath -> IO String+ --- | RP_writeFile -- :: FilePath -> String -> IO ()+ --- | RP_appendFile -- :: FilePath -> String -> IO () --- ** File locking @@ -194,7 +207,7 @@ --- ** Special cases for standard input and output - -- | These functions are also exported by the "Prelude".+ --- | These functions are also exported by the "Prelude". -- putChar -- :: Char -> IO () -- putStr -- :: String -> IO ()@@ -224,12 +237,12 @@ deriving (Show, Eq, Ord, Enum, Bounded) -{-# LINE 241 "src/ehc/CoreRun/Prim.chs" #-}+{-# LINE 254 "src/ehc/CoreRun/Prim.chs" #-} -- | Show prim without initial 3 chars showRunPrim :: RunPrim -> String showRunPrim p = drop 3 $ show p -{-# LINE 247 "src/ehc/CoreRun/Prim.chs" #-}+{-# LINE 260 "src/ehc/CoreRun/Prim.chs" #-} allRunPrimMp :: Map.Map String RunPrim allRunPrimMp = Map.fromList [ (showRunPrim p, p) | p <- [ minBound .. maxBound ] ]
@@ -7,1151 +7,1270 @@ , module Data.IORef , module Data.Int, module Data.Word , module GHC.Ptr-, RVal (..)-, mkTuple, mkUnit-, RValV, RValMV-, HSMarshall (..)-, HpPtr, nullPtr, isNullPtr, newHeap, Heap (..)-, heapGetM, heapGetM', heapAllocM, heapAllocAsPtrM, heapUpdM, heapSetM, heapSetM'-, RValCxt (..), emptyRValCxt-, rvalTrEnterLam-, mustReturn, needNotReturn, rvalRetEvl, rvalPrimargEvl-, rcxtUpdDatatypes-, vecReverseForM_-, mvecAllocInit, mvecAlloc, mvecFillFromV, mvecReverseFillFromV, mvecFillFromMV, mvecAllocFillFromV, mvecAppend, mvecToList-, mvecReverseForM_-, ptr2valM, ref2valM-, RValEnv (..), newRValEnv-, renvTopFrameM-, dumpEnvM-, updTopFrameM-, renvFrStkPush1, renvFrStkReversePushMV-, renvFrStkPop1, renvFrStkPopMV, renvFrStkReversePopMV, renvFrStkReversePopInMV-, rsemTr', rsemTr-, RValT )-where-import UHC.Light.Compiler.Base.HsName.Builtin-import UHC.Light.Compiler.Base.Common-import UHC.Light.Compiler.Error-import UHC.Light.Compiler.CoreRun-import UHC.Light.Compiler.CoreRun.Run-import UHC.Light.Compiler.CoreRun.Pretty-import UHC.Util.Pretty as PP-import UHC.Util.Utils-import Control.Monad.Primitive-import qualified Data.Vector as V-import qualified Data.Vector.Mutable as MV-import qualified Data.Vector.Generic as GV-import Data.Data-import Data.Typeable-import System.IO-import System.IO.Unsafe-import Data.IORef-import Data.Int-import Data.Word-import Data.Bits-import qualified Data.ByteString.Char8 as BSC8-import GHC.Ptr (Ptr (..))-import GHC.Exts (Addr#)-import GHC.Generics-import Control.Applicative-import qualified Data.Map as Map-import Data.Maybe--{-# LINE 73 "src/ehc/CoreRun/Run/Val.chs" #-}--- | Representation of run value-data RVal- =- -- Value representations for running itself: literals- RVal_Lit- { rvalSExp :: !SExp -- ^ a simple literal- }- | RVal_Char {-# UNPACK #-} !Char- | RVal_Int {-# UNPACK #-} !Int-{--- | RVal_Int8 {-# UNPACK #-} !Int8- | RVal_Int16 {-# UNPACK #-} !Int16--}- | RVal_Int32 {-# UNPACK #-} !Int32-{--- | RVal_Int64 {-# UNPACK #-} !Int64- | RVal_Word {-# UNPACK #-} !Word- | RVal_Word8 {-# UNPACK #-} !Word8- | RVal_Word16 {-# UNPACK #-} !Word16- | RVal_Word32 {-# UNPACK #-} !Word32- | RVal_Word64 {-# UNPACK #-} !Word64--}- | RVal_Integer !Integer- | RVal_Float {-# UNPACK #-} !Float- | RVal_Double {-# UNPACK #-} !Double- | RVal_PackedString !BSC8.ByteString -- ^ packed string, equivalent of low level C string (could be replaced by something more efficient)-- -- Value representations for running itself: function, application, etc- | RVal_Lam- { rvalMbNm :: !(Maybe HsName) -- ^ possibly bound to name- , rvalBody :: !Exp -- ^ a Exp_Lam, which also encodes a thunk- , rvalSLRef :: !(IORef HpPtr) -- ^ static link to enclosing stack frame- }- -- | special case of Lam taking 0 params- | RVal_Thunk- { rvalMbNm :: !(Maybe HsName) -- ^ possibly bound to name- , rvalBody :: !Exp -- ^ Exp taking no arguments (thunk)- , rvalSLRef :: !(IORef HpPtr) -- ^ static link to enclosing stack frame- }- | RVal_NodeMV- { rvalTag :: !Int -- {-# UNPACK #-} !RVal -- ^ node tag- , rvalNdMVals :: !RValMV -- ^ fields, mutable- }-{-- | RVal_NodeV- { rvalTag :: !Int -- {-# UNPACK #-} !RVal -- ^ node tag- , rvalNdVals :: !RValV -- ^ fields, immutable- }--}- | RVal_App- { rvalFun :: !RVal -- ^ a RVal_App or RVal_PApp- , rvalArgs :: !RValMV -- ^ already applied args- }- | RVal_Frame- { rvalRef2Nm :: Ref2Nm -- ^ ref to name mapping- , rvalSLRef :: !(IORef HpPtr) -- ^ immediately outer lexical level frame- -- , rvalLev :: !Int -- ^ the lexical level this frame is on- , rvalFrVals :: !RValMV -- ^ actual frame values, either literals or pointers to heap locations (so we can update them, share them)- , rvalFrSP :: !(IORef Int) -- ^ top of expr stack embedded in higher end of top frame- }- | RVal_Ptr- { rvalPtrRef :: !(IORef HpPtr) -- ^ ptr/index into heap- }- | RVal_Fwd- { rvalPtr :: !HpPtr -- ^ forwarding ptr, only used during GC- }- | RVal_BlackHole- | RVal_None-- -- Value representations for library or runtime env (not Core specific)- -- | mutable var- | RHsV_MutVar !(IORef RVal)- -- | IO handle- | RHsV_Handle !Handle- -- | Addr inside Ptr- | RHsV_Addr Addr#--instance Show RVal where- show _ = "RVal"--ppRVal' :: (HpPtr -> IO (Maybe RVal)) -> RVal -> IO PP_Doc-ppRVal' lkptr rval = case rval of- RVal_Lit e -> dfltpp e- RVal_Char v -> dfltpp $ show v- RVal_Int v -> dfltpp v-{--- RVal_Int8 v -> dfltpp $ show v- RVal_Int16 v -> dfltpp $ show v--}- RVal_Int32 v -> dfltpp $ show v-{--- RVal_Int64 v -> dfltpp $ show v- RVal_Word v -> dfltpp $ show v- RVal_Word8 v -> dfltpp $ show v- RVal_Word16 v -> dfltpp $ show v- RVal_Word32 v -> dfltpp $ show v- RVal_Word64 v -> dfltpp $ show v--}- RVal_Integer v -> dfltpp v- RVal_Float v -> dfltpp v- RVal_Double v -> dfltpp $ show v- RVal_PackedString v -> dfltpp $ show v- RVal_Lam mn b slref -> dfltpp b- RVal_Thunk mn e slref -> return $ ppBrackets e- RVal_NodeMV t vs -> do- vl <- mvecToList vs- return $ t >|< ppBracketsCommas vl- RVal_App f as -> dfltpp f -- return $ ppBrackets $ f >|< "@" >|< (ppParensCommas $ V.toList as)- RVal_Ptr pref -> do- p <- readIORef pref- vpp <- lkptr p >>= maybe (return PP.empty) (\v -> ppRVal' lkptr v >>= \vpp -> return $ " -> " >|< vpp)- return $ "*" >|< p >|< vpp- RVal_Fwd p -> return $ "f*" >|< p- RVal_Frame _ slref {- lv -} vs spref -> do- sl <- readIORef slref- sp <- readIORef spref- vl <- mvecToList vs- vlpp <- forM (zip [0..(sp-1)] vl) $ \(i,v) -> ppRVal' lkptr v >>= \vpp -> return $ i >|< ":" >#< vpp- return $ (ppBracketsCommas $ ["sl=" >|< sl, {- "lev=" >|< lv, -} "sz=" >|< MV.length vs, "sp=" >|< sp])- >-< vlist vlpp- RVal_BlackHole -> dfltpp "Hole"- RVal_None -> dfltpp "None"- RHsV_MutVar v -> dfltpp "MutVar"- RHsV_Handle h -> dfltpp $ show h- RHsV_Addr p -> dfltpp $ show (Ptr p)- where- dfltpp :: PP x => x -> IO PP_Doc- dfltpp = return . pp--ppRValWithHp :: Heap -> RVal -> IO PP_Doc-ppRValWithHp hp = ppRVal' (\p -> heapGetM'' hp p >>= (return . Just))--ppRVal :: RVal -> IO PP_Doc-ppRVal = ppRVal' (\_ -> return Nothing)--instance PP RVal where- pp rval = unsafePerformIO (ppRVal rval)--{-# LINE 213 "src/ehc/CoreRun/Run/Val.chs" #-}-mkTuple :: (RunSem RValCxt RValEnv RVal m a) => [RVal] -> RValT m a-mkTuple vs = liftIO (mvecAllocFillFromV $ crarrayFromList vs) >>= rsemNode 0 >>= rsemPush-{-# INLINE mkTuple #-}--mkUnit :: (RunSem RValCxt RValEnv RVal m a) => RValT m a-mkUnit = mkTuple []-{-# INLINE mkUnit #-}--{-# LINE 223 "src/ehc/CoreRun/Run/Val.chs" #-}--- Vector of RVal-type RValV = CRArray RVal---- Mutable vector of RVal-type RValMV = CRMArray RVal--{-# LINE 236 "src/ehc/CoreRun/Run/Val.chs" #-}--- | Marshalling from/to Haskell values-class HSMarshall hs where- -- | Marshall to Haskell value, also parameterized by evaluator- hsMarshall :: (RunSem RValCxt RValEnv RVal m a) => (RVal -> RValT m a) -> RVal -> RValT m hs- default hsMarshall :: (Generic hs, GHSMarshall (Rep hs), RunSem RValCxt RValEnv RVal m a) => (RVal -> RValT m a) -> RVal -> RValT m hs- hsMarshall evl v = to <$> ghsMarshall evl v- {-# INLINE hsMarshall #-}-- -- | Unmarshall from Haskell value- hsUnmarshall :: (RunSem RValCxt RValEnv RVal m a) => hs -> RValT m a- default hsUnmarshall :: (Generic hs, GHSMarshall (Rep hs), RunSem RValCxt RValEnv RVal m a) => hs -> RValT m a- hsUnmarshall = ghsUnmarshall . from- {-# INLINE hsUnmarshall #-}--{-# LINE 252 "src/ehc/CoreRun/Run/Val.chs" #-}-instance HSMarshall Int where- hsMarshall _ (RVal_Int v) = return v- hsMarshall _ v = err $ "CoreRun.Run.Val.HSMarshall Int:" >#< v- hsUnmarshall v = rsemPush $ RVal_Int v- {-# INLINE hsUnmarshall #-}--instance HSMarshall Integer where- hsMarshall _ (RVal_Integer v) = return v- hsMarshall _ v = err $ "CoreRun.Run.Val.HSMarshall Integer:" >#< v- hsUnmarshall v = rsemPush $ RVal_Integer v- {-# INLINE hsUnmarshall #-}--instance HSMarshall Bool {- where- hsMarshall _ (RVal_NodeMV t _) = return $ t == tagBoolTrue- hsMarshall _ v = err $ "CoreRun.Run.Val.HSMarshall Bool:" >#< v- hsUnmarshall b = liftIO (mvecAllocFillFromV emptyCRArray) >>= rsemNode (if b then tagBoolTrue else tagBoolFalse) >>= rsemPush- {-# INLINE hsUnmarshall #-}- -}--instance HSMarshall Char where- hsMarshall _ (RVal_Char v) = return v- hsMarshall _ v = err $ "CoreRun.Run.Val.HSMarshall Char:" >#< v- hsUnmarshall v = rsemPush $ RVal_Char v- {-# INLINE hsUnmarshall #-}--instance HSMarshall (Ptr a) where- hsMarshall _ (RHsV_Addr v) = return $ Ptr v- hsMarshall _ v = err $ "CoreRun.Run.Val.HSMarshall (Ptr a):" >#< v- hsUnmarshall (Ptr v) = rsemPush $ RHsV_Addr v- {-# INLINE hsUnmarshall #-}--instance HSMarshall Handle where- hsMarshall _ (RHsV_Handle v) = return v- hsMarshall _ v = err $ "CoreRun.Run.Val.HSMarshall Handle:" >#< v- hsUnmarshall v = rsemPush $ RHsV_Handle v- {-# INLINE hsUnmarshall #-}--{--instance HSMarshall [RVal] where- hsMarshall evl (RVal_NodeMV t as)- | t == tagListCons = liftIO (MV.read as 1) >>= evl >>= rsemPop >>= hsMarshall evl >>= \tl -> liftIO (MV.read as 0) >>= \hd -> return (hd : tl)- | otherwise = return []- hsMarshall _ v = err $ "CoreRun.Run.Val.HSMarshall [RVal]:" >#< v-- hsUnmarshall [] = liftIO (mvecAllocFillFromV emptyCRArray) >>= rsemNode tagListNil >>= rsemPush- hsUnmarshall (h:t) = hsUnmarshall t >>= rsemPop >>= \t' -> (liftIO $ mvecAllocFillFromV $ crarrayFromList [h, t']) >>= rsemNode tagListCons >>= rsemPush--instance HSMarshall x => HSMarshall [x] where- hsMarshall evl x = hsMarshall evl x >>= mapM (\v -> evl v >>= rsemPop >>= hsMarshall evl)- {-# INLINE hsMarshall #-}-- hsUnmarshall v = forM v (\e -> hsUnmarshall e >>= rsemPop) >>= hsUnmarshall- {-# INLINE hsUnmarshall #-}--}--{---}-instance HSMarshall x => HSMarshall [x]--{-# LINE 313 "src/ehc/CoreRun/Run/Val.chs" #-}--- | Generic marshalling from/to Haskell values-class GHSMarshall hs where- -- | Marshall to Haskell value, also parameterized by evaluator- ghsMarshall :: (RunSem RValCxt RValEnv RVal m a) => (RVal -> RValT m a) -> RVal -> RValT m (hs x)-- -- | Unmarshall from Haskell value- ghsUnmarshall :: (RunSem RValCxt RValEnv RVal m a) => hs x -> RValT m a--instance (Datatype d, MarshallSum hs) => GHSMarshall (D1 d hs) where- --- ghsMarshall evl v = do- dtmp <- asks rcxtDatatypeMp- let nm = datatypeName (undefined :: t d hs p)- case Map.lookup nm dtmp of- Nothing -> err $ "Marshall to HS lacks datatype info, datatype=" ++ nm- Just (RValDataconstrInfo {rdciMods=mods@(_:_:_)}) ->- err $ "Marshall to HS datatype info in multiple modules, datatype=" ++ nm ++ ", mods=" ++ show mods- Just (RValDataconstrInfo {rdciTg2Nm=tg2con}) -> do- r <- sumExtrTagged evl tg2con v- maybe (err $ "sumExtrTagged") (return . M1) r- --- ghsUnmarshall (M1 x) = do- dtmp <- asks rcxtDatatypeMp- let nm = datatypeName (undefined :: t d hs p)- case Map.lookup nm dtmp of- Nothing -> err $ "Marshall from HS lacks datatype info, datatype=" ++ nm- Just (RValDataconstrInfo {rdciMods=mods@(_:_:_)}) ->- err $ "Marshall from HS datatype info in multiple modules, datatype=" ++ nm ++ ", mods=" ++ show mods- Just (RValDataconstrInfo {rdciNm2Tg=con2tg}) ->- sumFillTagged con2tg x--{-# LINE 346 "src/ehc/CoreRun/Run/Val.chs" #-}--- | Marshall util: extract values from sum-class MarshallSum hs where- --- sumFillTagged- :: (RunSem RValCxt RValEnv RVal m a)- => RValDataconstrInfoNm2Tg -- ^ mapping from constructor name to tag- -> hs x -- ^ Haskell value- -> RValT m a- --- sumExtrTagged- :: (RunSem RValCxt RValEnv RVal m a)- => (RVal -> RValT m a) -- ^ force evaluation for nested fields- -> RValDataconstrInfoTg2Nm -- ^ mapping from constructor name to tag- -> RVal -- ^ the 'RVal_NodeMV' holding tag and fields- -> RValT m (Maybe (hs x))--instance ( MarshallProduct hs, ProductSize hs, Constructor c ) => MarshallSum (C1 c hs) where- --- sumFillTagged con2tg (M1 x) = do- v <- liftIO $ MV.unsafeNew len- productFillMVec v 0 len x- let nm = conName (undefined :: t c hs p)- mt = Map.lookup nm con2tg- when (isNothing mt) $ err $ "Marshall from HS lacks constructor info, constructor=" ++ nm- rsemNode (fromJust mt) v >>= rsemPush- where- len = (unTagged2 :: Tagged2 hs Int -> Int) productSize- tag = Map.findWithDefault 0 (conName (undefined :: t c hs p)) con2tg- {-# INLINE sumFillTagged #-}- --- sumExtrTagged evl tg2con v@(RVal_NodeMV {rvalTag=t, rvalNdMVals=mv})- | t >= V.length tg2con = err $ "Marshall to HS illegal tag value, con=" ++ nmc ++ ", tag=" ++ show t- | nmc == nmt = (Just . M1) <$> productExtrMVec evl mv 0 len- | otherwise = return $ Nothing -- Left $ "Marshall to HS lacks constructor info, con=" ++ nmc ++ "/" ++ nmt ++ ", tag=" ++ show t- where- len = (unTagged2 :: Tagged2 hs Int -> Int) productSize- nmc = conName (undefined :: t c hs p)- nmt = tg2con V.! t- {-# INLINE sumExtrTagged #-}--instance ( MarshallSum a, MarshallSum b ) => MarshallSum (a :+: b) where- --- sumFillTagged con2tg (L1 x) = sumFillTagged con2tg x- sumFillTagged con2tg (R1 x) = sumFillTagged con2tg x- {-# INLINE sumFillTagged #-}- --- -- sumExtrTagged evl tg2con v = (fmap L1 <$> sumExtrTagged evl tg2con v) <|> (fmap R1 <$> sumExtrTagged evl tg2con v)- sumExtrTagged evl tg2con v = do- l <- sumExtrTagged evl tg2con v- case l of- Just l' -> return $ fmap L1 l- _ -> fmap R1 <$> sumExtrTagged evl tg2con v- {-# INLINE sumExtrTagged #-}---{-# LINE 403 "src/ehc/CoreRun/Run/Val.chs" #-}--- | Marshall util: extract values from product (inspired by Aeson library)-class MarshallProduct hs where- -- | Fill vector from product- productFillMVec- :: (RunSem RValCxt RValEnv RVal m a)- => CRMArray RVal -- ^ fields vector- -> Int -- ^ index- -> Int -- ^ length- -> hs x -- ^ Haskell value- -> RValT m ()- -- | Extract product from vector- productExtrMVec- :: (RunSem RValCxt RValEnv RVal m a)- => (RVal -> RValT m a) -- ^ force evaluation for nested fields- -> CRMArray RVal -- ^ fields vector- -> Int -- ^ index- -> Int -- ^ length- -> RValT m (hs x)--instance (MarshallProduct a, MarshallProduct b) => MarshallProduct (a :*: b) where- productFillMVec mv ix len (a :*: b) = do- productFillMVec mv ix lenL a- productFillMVec mv ixR lenR b- where- lenL = len `unsafeShiftR` 1- ixR = ix + lenL- lenR = len - lenL- {-# INLINE productFillMVec #-}-- productExtrMVec evl mv ix len =- (:*:) <$> productExtrMVec evl mv ix lenL- <*> productExtrMVec evl mv ixR lenR- where- lenL = len `unsafeShiftR` 1- ixR = ix + lenL- lenR = len - lenL- {-# INLINE productExtrMVec #-}--instance MarshallProduct hs => MarshallProduct (S1 s hs) where- productFillMVec mv ix l (M1 x) = productFillMVec mv ix l x- {-# INLINE productFillMVec #-}-- productExtrMVec evl mv ix l = M1 <$> productExtrMVec evl mv ix l- {-# INLINE productExtrMVec #-}--instance HSMarshall x => MarshallProduct (K1 i x) where- productFillMVec mv ix _ (K1 x) = do- x' <- rsemPop =<< hsUnmarshall x- liftIO $ MV.unsafeWrite mv ix x'- {-# INLINE productFillMVec #-}-- productExtrMVec evl mv ix _ = do- v <- (liftIO $ MV.read mv ix) >>= evl >>= rsemPop- K1 <$> hsMarshall evl v- {-# INLINE productExtrMVec #-}--instance MarshallProduct U1 where- productFillMVec mv ix _ U1 = return ()- {-# INLINE productFillMVec #-}-- productExtrMVec evl mv ix _ = return U1- {-# INLINE productExtrMVec #-}--{-# LINE 468 "src/ehc/CoreRun/Run/Val.chs" #-}--- | Phantom type tagging (from Aeson lib)-newtype Tagged s b = Tagged {unTagged :: b}---- | Phantom type tagging for higher kinds (from Aeson lib)-newtype Tagged2 (s :: * -> *) b = Tagged2 {unTagged2 :: b}--{-# LINE 476 "src/ehc/CoreRun/Run/Val.chs" #-}--- | Size (nr of fields) of data type constructors (from Aeson lib)-class ProductSize f where- productSize :: Tagged2 f Int--instance (ProductSize a, ProductSize b) => ProductSize (a :*: b) where- productSize = Tagged2 $ unTagged2 (productSize :: Tagged2 a Int) +- unTagged2 (productSize :: Tagged2 b Int)- {-# INLINE productSize #-}--instance ProductSize (S1 s a) where- productSize = Tagged2 1- {-# INLINE productSize #-}--instance ProductSize U1 where- productSize = Tagged2 0- {-# INLINE productSize #-}--{-# LINE 514 "src/ehc/CoreRun/Run/Val.chs" #-}--- | HpPtr is index into a heap-type HpPtr = Int--nullPtr :: HpPtr-nullPtr = -1--isNullPtr = (== nullPtr)--data Heap- = Heap- { hpVals :: {-# UNPACK #-} !RValMV -- ^ value array- , hpFirst :: {-# UNPACK #-} !HpPtr -- ^ the ptr of hpVals ! 0- , hpFree :: {-# UNPACK #-} !(IORef HpPtr) -- ^ first array location free for alloc- , hpSemispaceMultiplier :: {-# UNPACK #-} !(IORef Rational) -- ^ multiplier by which to enlarge/shrink subsequent semispace- }--newHeap :: Int -> IO Heap-newHeap sz = do- vs <- mvecAllocInit sz- fr <- newIORef 0- ml <- newIORef 1.5- return $ Heap vs 0 fr ml--{-# LINE 539 "src/ehc/CoreRun/Run/Val.chs" #-}--- | Garbage collect heap (TBD)-heapGcM :: (RunSem RValCxt RValEnv RVal m x) => RVal -> RValT m RVal--- heapGcM = err $ "CoreRun.Run.Val.heapGcM: GC not yet implemented"-heapGcM curV = do- -- rsemSetTrace True- -- rsemTr' True $ "GC starts, curV=" >#< curV- -- rsemTr $ "GC starts"- env@(RValEnv {renvHeap=hp@(Heap {hpVals=vsOld, hpSemispaceMultiplier=mlRef, hpFirst=offOld, hpFree=hpFrRef})- , renvGcRootStack=rootStkRef, renvTopFrame=topFrRef, renvStack=stkRef- , renvGlobalsMV=globals- }) <- get- env' <- liftIO $ do- ml <- readIORef mlRef- let szOld = MV.length vsOld- szNew = (round $ fromIntegral szOld * ml) :: Int- offNew = offOld + szOld- lwbOld = offOld- upbOld = offNew- vsNew <- mvecAllocInit szNew- greyref <- newIORef offNew- let -- copy content of old ptr to new loc, leaving a forwarding on to the old location- copyp p- -- is this indeed an old ptr?- | p >= lwbOld && p < upbOld = do- let pOld = p- iOld = pOld - offOld- v <- MV.read vsOld iOld- case v of- RVal_Fwd pNew -> do- -- putStrLn $ "GC copyp Fwd p=" ++ show pOld ++ ", pNew=" ++ show pNew- return pNew- v -> do- pNew <- readIORef greyref- let iNew = pNew - offNew- MV.write vsNew iNew v- MV.write vsOld iOld (RVal_Fwd pNew)- writeIORef greyref (pNew+1)- -- putStrLn $ "GC copyp Val p=" ++ show pOld ++ ", pNew=" ++ show pNew ++ ", v=" ++ show (pp v)- return pNew- | otherwise = do- -- putStrLn $ "GC copyp None p=" ++ show p- return p-- -- inspect RVal_Ptr only- copypv v = do- case v of- RVal_Ptr pref -> modifyIORefM pref copyp- _ -> return ()-- -- inspect, possibly copy internal part of a RVal, stops with a ptr which later is dealt with (to prevent too deep stack growth), exploiting the in between grey/black area as queue- copyv v = do- -- putStrLn $ "GC copyv 1 v=" ++ show (pp v)- case v of- RVal_Ptr pref -> modifyIORefM pref copyp- RVal_Frame {rvalSLRef=slref, rvalFrVals=vs, rvalFrSP=spref}- -> modifyIORefM slref copyp >> readIORef spref >>= \sp -> mvecForM_' 0 sp vs copyv- RVal_NodeMV {rvalNdMVals=vs} -> mvecForM_ vs copyv- RVal_App {rvalFun=f, rvalArgs=as} -> copyv f >> mvecForM_ as copyv- RVal_Thunk {rvalSLRef=slref} -> modifyIORefM slref copyp- RVal_Lam {rvalSLRef=slref} -> modifyIORefM slref copyp- _ -> return ()- -- putStrLn $ "GC copyv 2 v=" ++ show (pp v)-- -- inspect, follow, copy content of RVal- follow pBlk pGry- | pBlk < pGry = MV.read vsNew (pBlk-offNew) >>= copyv >> follow (pBlk+1) pGry- | otherwise = do- pGry' <- readIORef greyref- if pBlk < pGry' then follow pBlk pGry' else return pBlk-- -- initial copy: top frame- modifyIORefM topFrRef copyp --- $ \topFr -> {- if isNullPtr topFr then return topFr else -} copyp topFr-- -- initial copy: stack- modifyIORefM stkRef $ mapM copyp-- -- initial copy: globals- mvecLoop 0 (MV.length globals) (\v i -> MV.read v i >>= copyp >>= MV.write v i) globals-- -- initial copy: the RVal to be put on the heap- copyv curV-- -- initial copy: additional roots- readIORef rootStkRef >>= mapM_ (mapM_ copyv)-- -- follow with initial values of grey and black (0)- readIORef greyref >>= follow offNew >>= \p -> writeIORef hpFrRef (p - offNew)-- -- final:- return $ env { renvHeap = hp {hpVals=vsNew, hpFirst=offNew}}-- put env'- -- rsemTr $ "GC done"- -- rsemTr' True $ "GC done, curV=" >#< curV- -- rsemSetTrace False- return curV--{-# LINE 638 "src/ehc/CoreRun/Run/Val.chs" #-}--- | Allocate on the heap-heapAllocM :: (RunSem RValCxt RValEnv RVal m x) => RVal -> RValT m HpPtr-heapAllocM v = do- hp@(Heap {hpVals=vs, hpFirst=off, hpFree=fr}) <- gets renvHeap- p <- liftIO $ readIORef fr- if p >= MV.length vs- then heapGcM v >>= heapAllocM- else liftIO $ do- MV.write vs p v- writeIORef fr (p + 1)- return $ p + off---- | Allocate on the heap, packing as RVal_Ptr-heapAllocAsPtrM :: (RunSem RValCxt RValEnv RVal m x) => RVal -> RValT m RVal-heapAllocAsPtrM v = do- p <- heapAllocM v- liftIO (newIORef p) >>= (return . RVal_Ptr)--{---}--- | Get a value from the heap--- heapGetM'' :: PrimMonad m => Heap -> HpPtr -> m RVal-heapGetM'' :: Heap -> HpPtr -> IO RVal-heapGetM'' hp@(Heap {hpVals=vs, hpFirst=off}) p = MV.read vs (p - off)-{-# INLINE heapGetM'' #-}---- | Get a value from the heap-heapGetM' :: (RunSem RValCxt RValEnv RVal m x) => Heap -> HpPtr -> RValT m RVal-heapGetM' hp p = liftIO $ heapGetM'' hp p-{-# INLINE heapGetM' #-}---- | Get a value from the heap-heapGetM :: (RunSem RValCxt RValEnv RVal m x) => HpPtr -> RValT m RVal-heapGetM p = do- hp <- gets renvHeap- heapGetM' hp p-{-# INLINE heapGetM #-}---- | Set a value in the heap-heapSetM' :: (RunSem RValCxt RValEnv RVal m x) => Heap -> HpPtr -> RVal -> RValT m ()-heapSetM' hp@(Heap {hpVals=vs, hpFirst=off}) p v = liftIO $ MV.write vs (p - off) v-{-# INLINE heapSetM' #-}---- | Set a value in the heap-heapSetM :: (RunSem RValCxt RValEnv RVal m x) => HpPtr -> RVal -> RValT m ()-heapSetM p v = do- hp <- gets renvHeap- heapSetM' hp p v-{-# INLINE heapSetM #-}---- | Update a value in the heap-heapUpdM' :: (RunSem RValCxt RValEnv RVal m x) => Heap -> HpPtr -> (RVal -> RValT m RVal) -> RValT m ()-heapUpdM' hp@(Heap {hpVals=vs, hpFirst=off}) p f = do- let p' = p - off- v <- liftIO $ MV.read vs p'- v' <- f v- liftIO $ MV.write vs p' v'-{-# INLINE heapUpdM' #-}---- | Update a value in the heap-heapUpdM :: (RunSem RValCxt RValEnv RVal m x) => HpPtr -> (RVal -> RValT m RVal) -> RValT m ()-heapUpdM p f = do- hp <- gets renvHeap- heapUpdM' hp p f-{-# INLINE heapUpdM #-}--{-# LINE 710 "src/ehc/CoreRun/Run/Val.chs" #-}--- | Mapping between constr name and tag-type RValDataconstrInfoNm2Tg = Map.Map String Int -- from constructor name to tag-type RValDataconstrInfoTg2Nm = CRArray String -- from tag to constructor Name---- | Mapping between constr name and tag-data RValDataconstrInfo- = RValDataconstrInfo- { rdciNm2Tg :: RValDataconstrInfoNm2Tg -- from constructor name to tag- , rdciTg2Nm :: RValDataconstrInfoTg2Nm -- from tag to constructor Name- , rdciMods :: [HsName] -- modules (if any in which possibly multiple defs occur, >1 being an error when actually used)- }- deriving Show--emptyRValDataconstrInfo = RValDataconstrInfo Map.empty emptyCRArray []---- | Mapping from type name to constr info-type RValDatatypeMp- = Map.Map- String -- type name- RValDataconstrInfo -- data constr info---- | Union-rvalDatatypeMpUnion :: RValDatatypeMp -> RValDatatypeMp -> RValDatatypeMp-rvalDatatypeMpUnion = Map.unionWith (\l r -> l {rdciMods = rdciMods l ++ rdciMods r})---- | Unions-rvalDatatypeMpUnions1 :: [RValDatatypeMp] -> RValDatatypeMp-rvalDatatypeMpUnions1 = foldr1 rvalDatatypeMpUnion---- | Extract datatype mapping from module-rvalDatatypeMpFromMod :: Mod -> RValDatatypeMp-rvalDatatypeMpFromMod (Mod_Mod {metas_Mod_Mod=metas})- = Map.fromList- [ ( show tn'- , emptyRValDataconstrInfo- { rdciNm2Tg = Map.fromList cts- , rdciTg2Nm = crarrayFromList $ map fst $ sortOn snd cts- , rdciMods = mods- })- | Meta_Data {tyNm_Meta_Data=tn, dataCons_Meta_Data=constrs} <- metas- , let cts = assocLMapKey show $ candtg constrs- (tn',mods) = splitTN tn- ]- where candtg cs = [ (cn,t) | DataCon_Con {conNm_DataCon_Con=cn, tagNr_DataCon_Con=t} <- cs ]- splitTN n = (hsnQualified n, maybe [] (:[]) $ hsnQualifier n)--{-# LINE 766 "src/ehc/CoreRun/Run/Val.chs" #-}--- | Environment: context/reader-data RValCxt- = RValCxt- { rcxtInRet :: !Bool -- ^ in returning context, True by default- , rcxtCallCxt :: [Maybe HsName] -- ^ calling context stack, for debugging only- , rcxtDatatypeMp :: RValDatatypeMp -- ^ dataype info for ffi- }- deriving Show--emptyRValCxt :: RValCxt-emptyRValCxt = RValCxt True [] m- where m = rvalDatatypeMpUnions1- [ Map.singleton n (emptyRValDataconstrInfo {rdciNm2Tg = Map.singleton n 0, rdciTg2Nm = crarrayFromList [n]})- | tuparity <- [2..15], let n = "(" ++ replicate (tuparity-1) ',' ++ ")"- ]--{-# LINE 784 "src/ehc/CoreRun/Run/Val.chs" #-}-rvalTrEnterLam :: RunSem RValCxt RValEnv RVal m x => Maybe HsName -> RValT m a -> RValT m a-rvalTrEnterLam s = local (\r -> r {rcxtCallCxt = s : rcxtCallCxt r})--{-# LINE 789 "src/ehc/CoreRun/Run/Val.chs" #-}--- | Set return context to True-mustReturn :: RunSem RValCxt RValEnv RVal m x => RValT m a -> RValT m a-mustReturn = local (\r -> r {rcxtInRet = True})-{-# INLINE mustReturn #-}---- | Set return context to False-needNotReturn :: RunSem RValCxt RValEnv RVal m x => RValT m a -> RValT m a-needNotReturn = local (\r -> r {rcxtInRet = False})-{-# INLINE needNotReturn #-}---- | Variation of `rsemEvl` in return context-rvalRetEvl :: RunSem RValCxt RValEnv RVal m x => RVal -> RValT m x-rvalRetEvl = mustReturn . rsemEvl-{-# INLINE rvalRetEvl #-}---- | Variation of `rsemEvl` in primitve argument context-rvalPrimargEvl :: RunSem RValCxt RValEnv RVal m x => RVal -> RValT m x-rvalPrimargEvl x = rvalRetEvl x >>= rsemPop >>= rsemDeref-{-# INLINE rvalPrimargEvl #-}--{-# LINE 811 "src/ehc/CoreRun/Run/Val.chs" #-}--- | Update with datatype info-rcxtUpdDatatypes :: RunSem RValCxt RValEnv RVal m x => [Mod] -> RValT m RValCxt-rcxtUpdDatatypes mods = do- cx@(RValCxt {rcxtDatatypeMp=m}) <- ask- let cx' = cx {rcxtDatatypeMp = rvalDatatypeMpUnions1 $ m : map rvalDatatypeMpFromMod mods}- -- liftIO $ print cx'- return cx'--{-# LINE 825 "src/ehc/CoreRun/Run/Val.chs" #-}-{---- | Loop over a vector, starting at lower bound 'l', ending before 'h'-vecLoop :: Monad m => Int -> Int -> (V.Vector a -> Int -> m b) -> V.Vector a -> m ()-vecLoop l h m v = loop l- where loop l | l < h = m v l >> loop (l+1)- | otherwise = return ()-{-# INLINE vecLoop #-}--}---- | Loop over a vector from upb to lwb, starting before 'h', ending at lower bound 'l'-vecLoopReverse :: Monad m => Int -> Int -> (V.Vector a -> Int -> m b) -> V.Vector a -> m ()-vecLoopReverse l h m v = loop (h-1)- where loop h | l <= h = m v h >> loop (h-1)- | otherwise = return ()-{-# INLINE vecLoopReverse #-}---{-# LINE 844 "src/ehc/CoreRun/Run/Val.chs" #-}--- | Right to left forM_-vecReverseForM_ :: Monad m => V.Vector a -> (a -> m x) -> m ()-vecReverseForM_ v m = vecLoopReverse 0 (V.length v) (\_ i -> m (v V.! i)) v-{-# INLINE vecReverseForM_ #-}--{-# LINE 855 "src/ehc/CoreRun/Run/Val.chs" #-}--- | Allocate a mutable vector of given size-mvecAllocWith :: PrimMonad m => Int -> a -> m (MV.MVector (PrimState m) a)-mvecAllocWith = MV.replicate-{-# INLINE mvecAllocWith #-}---- | Allocate a mutable vector of given size, init to default value-mvecAllocInit :: Int -> IO RValMV-mvecAllocInit sz = mvecAllocWith sz RVal_None-{-# INLINE mvecAllocInit #-}---- | Allocate a mutable vector of given size-mvecAlloc :: PrimMonad m => Int -> m (MV.MVector (PrimState m) a)-mvecAlloc = MV.new-{-# INLINE mvecAlloc #-}---- | Loop over a mutable vector, updating the vector as a side effect, starting at lower bound 'l', ending before 'h'-mvecLoop :: PrimMonad m => Int -> Int -> (MV.MVector (PrimState m) a -> Int -> m b) -> MV.MVector (PrimState m) a -> m (MV.MVector (PrimState m) a)-mvecLoop l h m v = loop l- where loop l | l < h = m v l >> loop (l+1)- | otherwise = return v-{-# INLINE mvecLoop #-}---- | Loop over a mutable vector from upb to lwb, updating the vector as a side effect, starting before 'h', ending at lower bound 'l'-mvecLoopReverse :: PrimMonad m => Int -> Int -> (MV.MVector (PrimState m) a -> Int -> m b) -> MV.MVector (PrimState m) a -> m (MV.MVector (PrimState m) a)-mvecLoopReverse l h m v = loop (h-1)- where loop h | l <= h = m v h >> loop (h-1)- | otherwise = return v-{-# INLINE mvecLoopReverse #-}---- | Loop over a mutable vector from upb to lwb, updating the vector as a side effect, starting before 'h', ending at lower bound 'l'-mvecLoopReverseAccum :: PrimMonad m => acc -> Int -> Int -> (acc -> Int -> m acc) -> MV.MVector (PrimState m) a -> m acc-mvecLoopReverseAccum a l h m v = loop (h-1) a- where loop h a | l <= h = m a h >>= loop (h-1)- | otherwise = return a-{-# INLINE mvecLoopReverseAccum #-}---- | Convert to a list-mvecToList :: PrimMonad m => MV.MVector (PrimState m) a -> m [a]-mvecToList v = mvecLoopReverseAccum [] 0 (MV.length v) (\l i -> MV.read v i >>= \a -> return (a:l)) v---- | Fill a mutable vector from a unmutable vector, starting with filling at the given lowerbound-mvecFillFromV :: PrimMonad m => Int -> MV.MVector (PrimState m) a -> CRArray a -> m ()-mvecFillFromV lwb toarr frarr = forM_ (craAssocs' lwb frarr) $ \(i,e) -> MV.write toarr i e-{-# INLINE mvecFillFromV #-}---- | Fill a mutable vector from a unmutable vector, starting with filling at the given lowerbound, reversing the given vector-mvecReverseFillFromV :: PrimMonad m => Int -> MV.MVector (PrimState m) a -> CRArray a -> m ()-mvecReverseFillFromV lwb toarr frarr = forM_ (craReverseAssocs' lwb frarr) $ \(i,e) -> MV.write toarr i e-{-# INLINE mvecReverseFillFromV #-}---- | Fill a mutable vector from another mutable vector, starting with copying at the given lowerbounds, copying size elements-mvecFillFromMV' :: PrimMonad m => Int -> Int -> Int -> MV.MVector (PrimState m) a -> MV.MVector (PrimState m) a -> m ()-mvecFillFromMV' lwbTo lwbFr sz toarr frarr = mvecLoop lwbFr (lwbFr+sz) (\v i -> MV.read v i >>= MV.write toarr (i+lwbDiff)) frarr >> return ()- where lwbDiff = lwbTo - lwbFr-{-# INLINE mvecFillFromMV' #-}---- | Fill a mutable vector from another mutable vector, starting with copying at the given lowerbounds, copying size elements, but reversing the given vector-mvecReverseFillFromMV' :: PrimMonad m => Int -> Int -> Int -> MV.MVector (PrimState m) a -> MV.MVector (PrimState m) a -> m ()--- mvecReverseFillFromMV' lwbTo lwbFr sz toarr frarr = mvecLoop lwbFr (lwbFr+sz) (\v i -> MV.read v (upbFr1-i) >>= MV.write toarr (i+lwbDiff)) frarr >> return ()-mvecReverseFillFromMV' lwbTo lwbFr sz toarr frarr = mvecLoopReverse lwbFr (lwbFr+sz) (\v i -> MV.read v i >>= MV.write toarr (upbFr1 - i + lwbTo)) frarr >> return ()- where lwbDiff = lwbTo - lwbFr- upbFr1 = lwbFr + sz - 1-{-# INLINE mvecReverseFillFromMV' #-}---- | Fill a mutable vector from another mutable vector, starting with filling at the given lowerbound-mvecFillFromMV :: PrimMonad m => Int -> MV.MVector (PrimState m) a -> MV.MVector (PrimState m) a -> m ()--- mvecFillFromMV lwb toarr frarr = mvecLoop 0 (MV.length frarr) (\v i -> MV.read frarr i >>= MV.write toarr (i+lwb)) frarr >> return ()-mvecFillFromMV lwb toarr frarr = mvecFillFromMV' lwb 0 (MV.length frarr) toarr frarr-{-# INLINE mvecFillFromMV #-}--- {-# SPECIALIZE mvecFillFromMV :: Int -> MV.MVector (PrimState IO) a -> MV.MVector (PrimState IO) a -> IO () #-}---- | Fill a mutable vector from another mutable vector, starting with filling at the given lowerbound, but reversing the given vector-mvecReverseFillFromMV :: PrimMonad m => Int -> MV.MVector (PrimState m) a -> MV.MVector (PrimState m) a -> m ()-mvecReverseFillFromMV lwb toarr frarr = mvecReverseFillFromMV' lwb 0 (MV.length frarr) toarr frarr-{--mvecReverseFillFromMV lwb toarr frarr = mvecLoop 0 l (\v i -> MV.read frarr (l1-i) >>= MV.write toarr (i+lwb)) frarr >> return ()- where l = MV.length frarr- l1 = l - 1--}-{-# INLINE mvecReverseFillFromMV #-}---- | Alloc and fill vector of size taken from fixed vec-mvecAllocFillFromV :: PrimMonad m => CRArray a -> m (MV.MVector (PrimState m) a)-mvecAllocFillFromV frarr = mvecAlloc (V.length frarr) >>= \toarr -> mvecFillFromV 0 toarr frarr >> return toarr-{-# INLINE mvecAllocFillFromV #-}---- | Loop over a mutable vector, updating the vector as a side effect, with explicit range-mvecForM_' :: PrimMonad m => Int -> Int -> MV.MVector (PrimState m) a -> (a -> m b) -> m ()-mvecForM_' lwb upb v m = mvecLoop lwb upb (\v i -> MV.read v i >>= m) v >> return ()-{-# INLINE mvecForM_' #-}---- | Loop over a mutable vector, updating the vector as a side effect-mvecForM_ :: PrimMonad m => MV.MVector (PrimState m) a -> (a -> m b) -> m ()-mvecForM_ v m = mvecForM_' 0 (MV.length v) v m-{-# INLINE mvecForM_ #-}---- | Append mutable 2 vectors-mvecAppend :: PrimMonad m => MV.MVector (PrimState m) a -> MV.MVector (PrimState m) a -> m (MV.MVector (PrimState m) a)-mvecAppend v1 v2 =- mvecAlloc l12 >>= mvecLoop 0 l1 (\v i -> MV.read v1 i >>= MV.write v i) >>= mvecLoop l1 l12 (\v i -> MV.read v2 (i-l1) >>= MV.write v i)- where- l1 = MV.length v1- l2 = MV.length v2- l12 = l1 + l2--{-# LINE 962 "src/ehc/CoreRun/Run/Val.chs" #-}--- | Right to left forM_-mvecReverseForM_ :: PrimMonad m => MV.MVector (PrimState m) a -> (a -> m x) -> m ()-mvecReverseForM_ v m = mvecLoopReverse 0 (MV.length v) (\v i -> MV.read v i >>= m) v >> return ()-{-# INLINE mvecReverseForM_ #-}--{-# LINE 973 "src/ehc/CoreRun/Run/Val.chs" #-}--- | Dereference a possibly RVal_Ptr-ptr2valM :: (RunSem RValCxt RValEnv RVal m x) => RVal -> RValT m RVal-ptr2valM v = case v of- RVal_Ptr pref -> liftIO (readIORef pref) >>= heapGetM >>= \v' -> case v' of- RVal_Thunk {} -> return v- _ -> ptr2valM v'- _ -> return v-{-# INLINE ptr2valM #-}---- | Dereference a RRef-ref2valM :: (RunSem RValCxt RValEnv RVal m x) => RRef -> RValT m RVal-ref2valM r = do- -- rsemTr $ "R: " ++ show (pp r)- env <- get- case r of- RRef_Glb m e -> do- modFrame <- heapGetM =<< liftIO (MV.read (renvGlobalsMV env) m)- liftIO $ MV.read (rvalFrVals modFrame) e-{-- RRef_Loc l o -> do- topfrp <- renvTopFrameM- topfr <- heapGetM topfrp- access topfr- where- access (RVal_Frame {rvalLev=frlev, rvalFrVals=vs}) | l == frlev = do- -- rsemTr $ "R o=" ++ show o ++ " len(vs)=" ++ show (MV.length vs)- liftIO $ MV.read vs o- access (RVal_Frame {rvalLev=frlev, rvalSLRef=slref}) = do- sl <- liftIO $ readIORef slref- -- rsemTr $ "R sl=" ++ show sl ++ " frlev=" ++ show frlev ++ " l=" ++ show l- heapGetM sl >>= access- access v =- err $ "CoreRun.Run.Val.ref2valM.RRef_Loc.access:" >#< r >#< "in" >#< v--}- RRef_LDf ld o -> do- topfrp <- renvTopFrameM- topfr <- heapGetM topfrp- access ld topfr- where- access 0 (RVal_Frame {rvalFrVals=vs}) =- liftIO $ MV.read vs o- access ld (RVal_Frame {rvalSLRef=slref}) = do- sl <- liftIO $ readIORef slref- fr <- heapGetM sl- access (ld-1) fr- access _ v =- err $ "CoreRun.Run.Val.ref2valM.RRef_LDf.access:" >#< r >#< "in" >#< v- RRef_Fld r e -> do- v <- ptr2valM =<< ref2valM r -- >>= rsemDeref- case v of- RVal_NodeMV _ vs -> liftIO $ MV.read vs e- _ -> err $ "CoreRun.Run.Val.ref2valM.RRef_Fld:" >#< e >#< "in" >#< v- RRef_Tag r -> do- v <- ptr2valM =<< ref2valM r -- >>= rsemDeref- case v of- RVal_NodeMV t _ -> return $ RVal_Int t- _ -> err $ "CoreRun.Run.Val.ref2valM.RRef_Tag:" >#< v- _ -> err $ "CoreRun.Run.Val.ref2valM.r:" >#< r-{-# INLINE ref2valM #-}--{-# LINE 1040 "src/ehc/CoreRun/Run/Val.chs" #-}--- | Frame holding locals indexed by RRef_Loc-type RValFrame = HpPtr -- points to heap to a RVal_Frame---- | Frame Stack-type RValStack = [RValFrame]---- | Environment: state-data RValEnv- = RValEnv- { renvGlobalsMV :: !(CRMArray RValFrame) -- ^ per module frame of globals- , renvStack :: !(IORef RValStack) -- ^ stack of frames, except for the top- , renvTopFrame :: !(IORef RValFrame) -- ^ current frame, the actual top of the stack- -- , renvFrSP :: !(IORef Int) -- ^ top of expr stack embedded in higher end of top frame- , renvHeap :: !Heap -- ^ heap- , renvDoTrace :: !Bool- , renvDoTraceExt :: !Bool -- ^ when tracing, do it extensively?- , renvGcRootStack :: !(IORef [[RVal]]) -- ^ stack of roots for GC, use is optional- }--newRValEnv :: Int -> IO RValEnv-newRValEnv hpSz = do- st <- newIORef []- tp <- newIORef nullPtr- hp <- newHeap hpSz- -- sp <- newIORef 0- rtst <- newIORef []- gl <- MV.new 0- return $ RValEnv gl st tp hp False False rtst--{-# LINE 1071 "src/ehc/CoreRun/Run/Val.chs" #-}--- | Get the top most frame from the stack, 'nullPtr' if absent-renvTopFrameM :: (RunSem RValCxt RValEnv RVal m x) => RValT m HpPtr-renvTopFrameM = do- (RValEnv {renvTopFrame=tf}) <- get- liftIO $ readIORef tf-{-# INLINE renvTopFrameM #-}--{-# LINE 1080 "src/ehc/CoreRun/Run/Val.chs" #-}--- | Get all non empty stack frames, still split up in (possibly null) top frame and rest of stack-renvAllFrameM' :: (RunSem RValCxt RValEnv RVal m x) => RValT m (Maybe HpPtr,[HpPtr])-renvAllFrameM' = do- topfrp <- renvTopFrameM- env <- get- st <- liftIO $ readIORef (renvStack env)- return (if isNullPtr topfrp then Nothing else Just topfrp, st)---- | Get all non empty stack frames-renvAllFrameM :: (RunSem RValCxt RValEnv RVal m x) => RValT m [HpPtr]-renvAllFrameM = do- (mbtop,st) <- renvAllFrameM'- return $ maybe [] (:[]) mbtop ++ st--{-# LINE 1096 "src/ehc/CoreRun/Run/Val.chs" #-}--- | Dump environment-dumpPpEnvM :: (RunSem RValCxt RValEnv RVal m x) => Bool -> RValT m PP_Doc-dumpPpEnvM extensive = do- stkfrs <- renvAllFrameM- env <- get- callcxt <- asks rcxtCallCxt- let hp = renvHeap env- stkfrspp <- forM stkfrs $ dumpFrameMinimal hp- hpfr <- liftIO $ readIORef (hpFree hp)- needRet <- asks rcxtInRet- let dash = "===================="- header1 = dash >-< "rcxtInRet=" >|< needRet- header2 = ppCurly $ "Heap =" >|< hpfr >|< "/" >|< MV.length (hpVals hp) >|< ", CallCxt=" >|< ppBracketsCommas callcxt >|< ", Stack=" >|< ppBracketsCommas stkfrspp- footer1 = dash- hpPP <- dumpHeap hp hpfr- glPP <- dumpGlobalsMV hp (renvGlobalsMV env)- frPPs <- forM stkfrs $ dumpFrame hp- if extensive- then return $ header1 >-< header2 >-< hpPP >-< glPP >-< "====== Frames ======" >-< (indent 2 $ vlist frPPs) >-< footer1- else return $ header2- where- dumpFrameMinimal hp fp = do- fr@(RVal_Frame {rvalFrVals=vs, rvalFrSP=spref}) <- heapGetM fp- sp <- liftIO $ readIORef spref- return $ fp >|< (ppParens $ sp >|< "/" >|< MV.length vs)- dumpFrame hp fp = do- fr@(RVal_Frame {rvalFrVals=vs, rvalFrSP=spref}) <- heapGetM fp- sp <- liftIO $ readIORef spref- -- pps <- ppa 0 hp sp vs- (liftIO $ ppRValWithHp hp fr) >>= \frpp -> return $ "Frame ptr=" >|< fp >|< " sp=" >|< sp >-< (indent 2 $ frpp) -- >-< (indent 2 $ vlist pps))- dumpGlobalsMV hp glbls = do- pps <- liftIO (mvecToList glbls) >>= \l -> forM l $ dumpFrame hp- return $ "====== Globals ======" >-< indent 2 (vlist pps)- dumpHeap hp@(Heap {hpFirst=off}) hpfr = do- pps <- ppa off hp hpfr (hpVals hp)- return $ "======= Heap =======" >-< indent 2 (vlist pps)- ppb hp k v = (liftIO $ ppRValWithHp hp v) >>= \vpp -> return $ k >|< ":" >#< vpp- ppa off hp sz vs = forM [0 .. sz - 1] $ \i -> liftIO (MV.read vs i) >>= ppb hp (i + off)--{-# LINE 1137 "src/ehc/CoreRun/Run/Val.chs" #-}--- | Dump environment-dumpEnvM :: (RunSem RValCxt RValEnv RVal m x) => Bool -> RValT m ()-dumpEnvM extensive = dumpPpEnvM extensive >>= \p -> liftIO $ putPPLn p >> hFlush stdout--{-# LINE 1147 "src/ehc/CoreRun/Run/Val.chs" #-}--- | Update top frame-updTopFrameM :: (RunSem RValCxt RValEnv RVal m x) => (RVal -> RValT m RVal) -> RValT m ()-updTopFrameM f = renvTopFrameM >>= flip heapUpdM f-{-# INLINE updTopFrameM #-}--{-# LINE 1159 "src/ehc/CoreRun/Run/Val.chs" #-}--- | Push on the stack embedded in the top frame-renvFrStkPush' :: RunSem RValCxt RValEnv RVal m x => (Int -> RValMV -> v -> IO Int) -> v -> RValT m ()-renvFrStkPush' pushvOn v = do- (RValEnv {renvTopFrame=frref, renvHeap=hp}) <- get- liftIO $ do- (RVal_Frame {rvalFrVals=frvs, rvalFrSP=spref}) <- heapGetM'' hp =<< readIORef frref- sp <- readIORef spref- sp' <- pushvOn sp frvs v- writeIORef spref sp'---- | Push on the stack embedded in the top frame-renvFrStkPush1 :: RunSem RValCxt RValEnv RVal m x => RVal -> RValT m ()-renvFrStkPush1 = renvFrStkPush' (\sp frvs v -> MV.write frvs sp v >> return (sp + 1))-{-# INLINE renvFrStkPush1 #-}---- | Push on the stack embedded in the top frame-renvFrStkPushMV :: RunSem RValCxt RValEnv RVal m x => RValMV -> RValT m ()-renvFrStkPushMV = renvFrStkPush' (\sp frvs vs -> mvecFillFromMV sp frvs vs >> return (sp + MV.length vs))-{-# INLINE renvFrStkPushMV #-}---- | Push reversed on the stack embedded in the top frame-renvFrStkReversePushMV :: RunSem RValCxt RValEnv RVal m x => RValMV -> RValT m ()-renvFrStkReversePushMV = renvFrStkPush' (\sp frvs vs -> mvecReverseFillFromMV sp frvs vs >> return (sp + MV.length vs))-{-# INLINE renvFrStkReversePushMV #-}---- | Push on the stack embedded in the top frame-renvFrStkPushV :: RunSem RValCxt RValEnv RVal m x => RValV -> RValT m ()-renvFrStkPushV = renvFrStkPush' (\sp frvs vs -> mvecFillFromV sp frvs vs >> return (sp + V.length vs))-{-# INLINE renvFrStkPushV #-}---- | Push reversed on the stack embedded in the top frame-renvFrStkReversePushV :: RunSem RValCxt RValEnv RVal m x => RValV -> RValT m ()-renvFrStkReversePushV = renvFrStkPush' (\sp frvs vs -> mvecReverseFillFromV sp frvs vs >> return (sp + V.length vs))-{-# INLINE renvFrStkReversePushV #-}--{-# LINE 1196 "src/ehc/CoreRun/Run/Val.chs" #-}--- | Pop from the stack embedded in the top frame-renvFrStkPop' :: RunSem RValCxt RValEnv RVal m x => (RValMV -> Int -> IO v) -> Int -> RValT m v-renvFrStkPop' popvFrom sz = do- (RValEnv {renvTopFrame=frref, renvHeap=hp}) <- get- liftIO $ do- (RVal_Frame {rvalFrVals=frvs, rvalFrSP=spref}) <- heapGetM'' hp =<< readIORef frref- sp <- readIORef spref- let sp' = sp - sz- writeIORef spref sp'- popvFrom frvs sp'---- | Pop from the stack embedded in the top frame-renvFrStkPop :: RunSem RValCxt RValEnv RVal m x => Int -> RValT m ()-renvFrStkPop = renvFrStkPop' (\_ _ -> return ())-{-# INLINE renvFrStkPop #-}---- | Pop from the stack embedded in the top frame-renvFrStkPop1 :: RunSem RValCxt RValEnv RVal m x => RValT m RVal-renvFrStkPop1 = renvFrStkPop' MV.read 1-{-# INLINE renvFrStkPop1 #-}---- | Pop from the stack embedded in the top frame-renvFrStkPopInMV :: RunSem RValCxt RValEnv RVal m x => Int -> Int -> RValMV -> RValT m ()-renvFrStkPopInMV lwbTo sz vs = renvFrStkPop' (\frvs sp -> mvecFillFromMV' lwbTo sp sz vs frvs) sz-{-# INLINE renvFrStkPopInMV #-}---- | Pop from the stack embedded in the top frame-renvFrStkPopMV :: RunSem RValCxt RValEnv RVal m x => Int -> RValT m RValMV--- renvFrStkPopMV sz = renvFrStkPop' (\frvs sp -> mvecAlloc sz >>= \vs -> mvecFillFromMV' 0 sp sz vs frvs >> return vs) sz-renvFrStkPopMV sz = (liftIO $ mvecAlloc sz) >>= \vs -> renvFrStkPopInMV 0 sz vs >> return vs-{-# INLINE renvFrStkPopMV #-}---- | Pop from the stack embedded in the top frame-renvFrStkReversePopInMV :: RunSem RValCxt RValEnv RVal m x => Int -> Int -> RValMV -> RValT m ()-renvFrStkReversePopInMV lwbTo sz vs = renvFrStkPop' (\frvs sp -> mvecReverseFillFromMV' lwbTo sp sz vs frvs) sz-{-# INLINE renvFrStkReversePopInMV #-}---- | Pop from the stack embedded in the top frame-renvFrStkReversePopMV :: RunSem RValCxt RValEnv RVal m x => Int -> RValT m RValMV--- renvFrStkReversePopMV sz = renvFrStkPop' (\frvs sp -> mvecAlloc sz >>= \vs -> mvecReverseFillFromMV' 0 sp sz vs frvs >> return vs) sz-renvFrStkReversePopMV sz = (liftIO $ mvecAlloc sz) >>= \vs -> renvFrStkReversePopInMV 0 sz vs >> return vs-{-# INLINE renvFrStkReversePopMV #-}--{-# LINE 1245 "src/ehc/CoreRun/Run/Val.chs" #-}--- | Trace-rsemTr' :: (PP msg, RunSem RValCxt RValEnv RVal m x) => Bool -> msg -> RValT m ()-rsemTr' dumpExtensive msg = do- env <- get- when (renvDoTrace env) $ do- liftIO $ putStrLn $ show $ pp msg- dumpEnvM (dumpExtensive || renvDoTraceExt env)- liftIO $ hFlush stdout-{- INLINE rsemTr' #-}---- | Trace-rsemTr :: (PP msg, RunSem RValCxt RValEnv RVal m x) => msg -> RValT m ()-rsemTr = rsemTr' False-{- INLINE rsemTr #-}--{-# LINE 1266 "src/ehc/CoreRun/Run/Val.chs" #-}--- | RunT' variant for Val-type RValT m a = RunT' RValCxt RValEnv RVal m a--- type RValT m a = RunT' () () RValEnv m a-+, RCxt (..)+, mkRCxt, mkRCxtSl, rcxtCloneWithNewFrame+, RVal (..)+, mkTuple, mkUnit+, RValV, RValMV+, RValCxt (..), emptyRValCxt+, rvalTrEnterLam+, mustReturn, needNotReturn, rvalRetEvl, rvalPrimargEvl+, rcxtUpdDatatypes+, HpPtr, nullPtr, isNullPtr, newHeap, Heap (..)+, heapGetM, heapGetM', heapAllocM, heapAllocAsPtrM, heapUpdM, heapSetM, heapSetM'+, RValEnv (..), newRValEnv+, renvResolveModNames+, renvTopFramePtrM, renvTopFramePtrAndFrameM, renvTopFrameM+, dumpEnvM+, RValT+, HSMarshall (..)+, vecReverseForM_+, mvecAllocInit, mvecAlloc, mvecFillFromV, mvecReverseFillFromV, mvecFillFromMV, mvecAllocFillFromV, mvecAppend, mvecToList+, mvecReverseForM_+, ptr2valM, ref2valM+, updTopFrameM+, renvFrStkPush1, renvFrStkReversePushMV+, renvFrStkPop1, renvFrStkPopMV, renvFrStkReversePopMV, renvFrStkReversePopInMV+, rsemTr', rsemTr )+where+import UHC.Light.Compiler.Base.HsName.Builtin+import UHC.Light.Compiler.Base.Common+import UHC.Light.Compiler.Error+import UHC.Light.Compiler.CoreRun+import UHC.Light.Compiler.CoreRun.Run+import UHC.Light.Compiler.CoreRun.Pretty+import UHC.Util.Pretty as PP+import UHC.Util.Utils+import Control.Monad.Primitive+import qualified Data.Vector as V+import qualified Data.Vector.Mutable as MV+import qualified Data.Vector.Generic as GV+import Data.Data+import Data.Typeable+import System.IO+import System.IO.Unsafe+import Data.IORef+import Data.Int+import Data.Word+import Data.Bits+import qualified Data.ByteString.Char8 as BSC8+import GHC.Ptr (Ptr (..))+import GHC.Exts (Addr#)+import GHC.Generics+import Control.Applicative+import qualified Data.Map as Map+import Data.Maybe++{-# LINE 73 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | Runtime context: module + enclosing lambda. Note/TBD: reduces performance quite a bit...+data RCxt+ = RCxt+ { rcxtMdRef :: {-# UNPACK #-} !(IORef HpPtr) -- ^ the module we're in+ , rcxtSlRef :: {-# UNPACK #-} !(IORef HpPtr) -- ^ the enclosing lambda we're in+ }++instance Show RCxt where+ show _ = "RCxt"++{-# LINE 85 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | Make fresh 'RCxt' from module and enclosing frame ptr+mkRCxt :: HpPtr -> HpPtr -> IO RCxt+mkRCxt m f = liftM2 RCxt (newIORef m) (newIORef f)+{-# INLINE mkRCxt #-}++-- | Make fresh 'RCxt' enclosing frame ptr only (temporary hack)+mkRCxtSl :: HpPtr -> IO RCxt+mkRCxtSl = mkRCxt 0+{-# INLINE mkRCxtSl #-}++-- | Copy/share module ref, fresh frame ref+rcxtCloneWithNewFrame :: HpPtr -> RCxt -> IO RCxt+rcxtCloneWithNewFrame f cx = do+ f' <- newIORef f+ return $ cx {rcxtSlRef = f'}+{-# INLINE rcxtCloneWithNewFrame #-}++{-# LINE 108 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | Representation of run value+data RVal+ =+ -- Value representations for running itself: literals+ RVal_Lit+ { rvalSExp :: !SExp -- ^ a simple literal+ }+ | RVal_Char {-# UNPACK #-} !Char+ | RVal_Int {-# UNPACK #-} !Int+ | RVal_Int8 {-# UNPACK #-} !Int8+ | RVal_Int16 {-# UNPACK #-} !Int16+ | RVal_Int32 {-# UNPACK #-} !Int32+ | RVal_Int64 {-# UNPACK #-} !Int64+ | RVal_Word {-# UNPACK #-} !Word+ | RVal_Word8 {-# UNPACK #-} !Word8+ | RVal_Word16 {-# UNPACK #-} !Word16+ | RVal_Word32 {-# UNPACK #-} !Word32+ | RVal_Word64 {-# UNPACK #-} !Word64+ | RVal_Integer !Integer+ | RVal_Float {-# UNPACK #-} !Float+ | RVal_Double {-# UNPACK #-} !Double+ | RVal_PackedString {-# UNPACK #-} !BSC8.ByteString -- ^ packed string, equivalent of low level C string (could be replaced by something more efficient?)++ -- Value representations for running itself: function, application, etc+ | RVal_Lam+ { rvalMbNm :: !(Maybe HsName) -- ^ possibly bound to name+ , rvalBody :: !Exp -- ^ a Exp_Lam, which also encodes a thunk+ , rvalCx :: {-# UNPACK #-} !RCxt -- ^ links to enclosing context+ }+ -- | special case of Lam taking 0 params+ | RVal_Thunk+ { rvalMbNm :: !(Maybe HsName) -- ^ possibly bound to name+ , rvalBody :: !Exp -- ^ Exp taking no arguments (thunk)+ , rvalCx :: {-# UNPACK #-} !RCxt -- ^ links to enclosing context+ }+ | RVal_NodeMV+ { rvalTag :: !Int -- {-# UNPACK #-} !RVal -- ^ node tag+ , rvalNdMVals :: !RValMV -- ^ fields, mutable+ }+{-+ | RVal_NodeV+ { rvalTag :: !Int -- {-# UNPACK #-} !RVal -- ^ node tag+ , rvalNdVals :: !RValV -- ^ fields, immutable+ }+-}+ | RVal_App+ { rvalFun :: !RVal -- ^ a RVal_App or RVal_PApp+ , rvalArgs :: !RValMV -- ^ already applied args+ }+ | RVal_Frame+ { rvalRef2Nm :: Ref2Nm -- ^ ref to name mapping+ , rvalCx :: {-# UNPACK #-} !RCxt -- ^ links to enclosing context+ , rvalFrVals :: !RValMV -- ^ actual frame values, either literals or pointers to heap locations (so we can update them, share them)+ , rvalFrSP :: !(IORef Int) -- ^ top of expr stack embedded in higher end of top frame+ }+ | RVal_Module+ { rvalModNm :: HsName -- ^ name of module+ -- , rvalModImpsMV :: !(CRMArray RValModule) -- ^ imported modules, constructed at link time based on a global set of modules+ , rvalModImpsV :: !(CRArray Int) -- ^ re-index table (indexing into global module table) of imported modules, constructed at link time based on a global set of modules+ , rvalFrRef :: !(IORef HpPtr) -- ^ frame of this module+ }+ | RVal_Ptr+ { rvalPtrRef :: !(IORef HpPtr) -- ^ ptr/index into heap+ }+ | RVal_Fwd+ { rvalPtr :: !HpPtr -- ^ forwarding ptr, only used during GC+ }+ | RVal_BlackHole+ | RVal_None++ -- Value representations for library or runtime env (not Core specific)+ -- | mutable var+ | RHsV_MutVar !(IORef RVal)+ -- | IO handle+ | RHsV_Handle !Handle+ -- | Addr inside Ptr+ | RHsV_Addr Addr#++instance Show RVal where+ show _ = "RVal"++ppRVal' :: (HpPtr -> IO (Maybe RVal)) -> RVal -> IO PP_Doc+ppRVal' lkptr rval = case rval of+ RVal_Lit e -> dfltpp e+ RVal_Char v -> dfltpp $ show v+ RVal_Int v -> dfltpp v+ RVal_Int8 v -> dfltpp $ show v+ RVal_Int16 v -> dfltpp $ show v+ RVal_Int32 v -> dfltpp $ show v+ RVal_Int64 v -> dfltpp $ show v+ RVal_Word v -> dfltpp $ show v+ RVal_Word8 v -> dfltpp $ show v+ RVal_Word16 v -> dfltpp $ show v+ RVal_Word32 v -> dfltpp $ show v+ RVal_Word64 v -> dfltpp $ show v+ RVal_Integer v -> dfltpp v+ RVal_Float v -> dfltpp v+ RVal_Double v -> dfltpp $ show v+ RVal_PackedString v -> dfltpp $ show v+ RVal_Lam mn b _ -> dfltpp b+ RVal_Thunk mn e _ -> return $ ppBrackets e+ RVal_NodeMV t vs -> do+ vl <- mvecToList vs+ return $ t >|< ppBracketsCommas vl+ RVal_App f as -> dfltpp f -- return $ ppBrackets $ f >|< "@" >|< (ppParensCommas $ V.toList as)+ RVal_Ptr pref -> do+ p <- readIORef pref+ vpp <- lkptr p >>= maybe (return PP.empty) (\v -> ppRVal' lkptr v >>= \vpp -> return $ " -> " >|< vpp)+ return $ "*" >|< p >|< vpp+ RVal_Fwd p -> return $ "f*" >|< p+ RVal_Frame _ rcx {- lv -} vs spref -> do+ sl <- readIORef (rcxtSlRef rcx)+ sp <- readIORef spref+ vl <- mvecToList vs+ vlpp <- forM (zip [0..(sp-1)] vl) $ \(i,v) -> ppRVal' lkptr v >>= \vpp -> return $ i >|< ":" >#< vpp+ return $ (ppBracketsCommas $ ["sl=" >|< sl, {- "lev=" >|< lv, -} "sz=" >|< MV.length vs, "sp=" >|< sp])+ >-< vlist vlpp+ RVal_Module nm _ frref -> do+ fr <- readIORef frref+ return $ ppBracketsCommas ["mod=" >|< nm, "fr=" >|< fr]+ RVal_BlackHole -> dfltpp "Hole"+ RVal_None -> dfltpp "None"+ RHsV_MutVar v -> dfltpp "MutVar"+ RHsV_Handle h -> dfltpp $ show h+ RHsV_Addr p -> dfltpp $ show (Ptr p)+ where+ dfltpp :: PP x => x -> IO PP_Doc+ dfltpp = return . pp++ppRValWithHp :: Heap -> RVal -> IO PP_Doc+ppRValWithHp hp = ppRVal' (\p -> heapGetM'' hp p >>= (return . Just))++ppRVal :: RVal -> IO PP_Doc+ppRVal = ppRVal' (\_ -> return Nothing)++instance PP RVal where+ pp rval = unsafePerformIO (ppRVal rval)++{-# LINE 248 "src/ehc/CoreRun/Run/Val.chs" #-}+mkTuple :: (RunSem RValCxt RValEnv RVal m a) => [RVal] -> RValT m a+mkTuple vs = liftIO (mvecAllocFillFromV $ crarrayFromList vs) >>= rsemNode 0 >>= rsemPush+{-# INLINE mkTuple #-}++mkUnit :: (RunSem RValCxt RValEnv RVal m a) => RValT m a+mkUnit = mkTuple []+{-# INLINE mkUnit #-}++{-# LINE 258 "src/ehc/CoreRun/Run/Val.chs" #-}+-- Vector of RVal+type RValV = CRArray RVal++-- Mutable vector of RVal+type RValMV = CRMArray RVal++{-# LINE 270 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | Environment: context/reader+data RValCxt+ = RValCxt+ { rcxtInRet :: !Bool -- ^ in returning context, True by default+ , rcxtCallCxt :: [Maybe HsName] -- ^ calling context stack, for debugging only+ , rcxtDatatypeMp :: RValDatatypeMp -- ^ dataype info for ffi+ }+ deriving Show++emptyRValCxt :: RValCxt+emptyRValCxt = RValCxt True [] m+ where m = rvalDatatypeMpUnions1+ [ Map.singleton n (emptyRValDataconstrInfo {rdciNm2Tg = Map.singleton n 0, rdciTg2Nm = crarrayFromList [n]})+ | tuparity <- [2..15], let n = "(" ++ replicate (tuparity-1) ',' ++ ")"+ ]++{-# LINE 288 "src/ehc/CoreRun/Run/Val.chs" #-}+rvalTrEnterLam :: RunSem RValCxt RValEnv RVal m x => Maybe HsName -> RValT m a -> RValT m a+rvalTrEnterLam s = local (\r -> r {rcxtCallCxt = s : rcxtCallCxt r})++{-# LINE 293 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | Set return context to True+mustReturn :: RunSem RValCxt RValEnv RVal m x => RValT m a -> RValT m a+mustReturn = local (\r -> r {rcxtInRet = True})+{-# INLINE mustReturn #-}++-- | Set return context to False+needNotReturn :: RunSem RValCxt RValEnv RVal m x => RValT m a -> RValT m a+needNotReturn = local (\r -> r {rcxtInRet = False})+{-# INLINE needNotReturn #-}++-- | Variation of `rsemEvl` in return context+rvalRetEvl :: RunSem RValCxt RValEnv RVal m x => RVal -> RValT m x+rvalRetEvl = mustReturn . rsemEvl+{-# INLINE rvalRetEvl #-}++-- | Variation of `rsemEvl` in primitve argument context+rvalPrimargEvl :: RunSem RValCxt RValEnv RVal m x => RVal -> RValT m x+rvalPrimargEvl x = rvalRetEvl x >>= rsemPop >>= rsemDeref+{-# INLINE rvalPrimargEvl #-}++{-# LINE 315 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | Update with datatype info+rcxtUpdDatatypes :: RunSem RValCxt RValEnv RVal m x => [Mod] -> RValT m RValCxt+rcxtUpdDatatypes mods = do+ cx@(RValCxt {rcxtDatatypeMp=m}) <- ask+ let cx' = cx {rcxtDatatypeMp = rvalDatatypeMpUnions1 $ m : map rvalDatatypeMpFromMod mods}+ -- liftIO $ print cx'+ return cx'++{-# LINE 329 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | HpPtr is index into a heap+type HpPtr = Int++nullPtr :: HpPtr+nullPtr = -1++isNullPtr = (== nullPtr)++data Heap+ = Heap+ { hpVals :: {-# UNPACK #-} !RValMV -- ^ value array+ , hpFirst :: {-# UNPACK #-} !HpPtr -- ^ the ptr of hpVals ! 0+ , hpFree :: {-# UNPACK #-} !(IORef HpPtr) -- ^ first array location free for alloc+ , hpSemispaceMultiplier :: {-# UNPACK #-} !(IORef Rational) -- ^ multiplier by which to enlarge/shrink subsequent semispace+ }++newHeap :: Int -> IO Heap+newHeap sz = do+ vs <- mvecAllocInit sz+ fr <- newIORef 0+ ml <- newIORef 1.5+ return $ Heap vs 0 fr ml++{-# LINE 354 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | Garbage collect heap (TBD)+heapGcM :: (RunSem RValCxt RValEnv RVal m x) => RVal -> RValT m RVal+-- heapGcM = err $ "CoreRun.Run.Val.heapGcM: GC not yet implemented"+heapGcM curV = do+ -- rsemSetTrace True+ -- rsemTr' True $ "GC starts, curV=" >#< curV+ -- rsemTr $ "GC starts"+ env@(RValEnv {renvHeap=hp@(Heap {hpVals=vsOld, hpSemispaceMultiplier=mlRef, hpFirst=offOld, hpFree=hpFrRef})+ , renvGcRootStack=rootStkRef, renvTopFrame=topFrRef, renvStack=stkRef+ , renvGlobalsMV=globals+ , renvModulesMV=modules+ }) <- get+ env' <- liftIO $ do+ ml <- readIORef mlRef+ let szOld = MV.length vsOld+ szNew = (round $ fromIntegral szOld * ml) :: Int+ offNew = offOld + szOld+ lwbOld = offOld+ upbOld = offNew+ vsNew <- mvecAllocInit szNew+ greyref <- newIORef offNew+ let -- copy content of old ptr to new loc, leaving a forwarding on to the old location+ copyp p+ -- is this indeed an old ptr?+ | p >= lwbOld && p < upbOld = do+ let pOld = p+ iOld = pOld - offOld+ v <- MV.read vsOld iOld+ case v of+ RVal_Fwd pNew -> do+ -- putStrLn $ "GC copyp Fwd p=" ++ show pOld ++ ", pNew=" ++ show pNew+ return pNew+ v -> do+ pNew <- readIORef greyref+ let iNew = pNew - offNew+ MV.write vsNew iNew v+ MV.write vsOld iOld (RVal_Fwd pNew)+ writeIORef greyref (pNew+1)+ -- putStrLn $ "GC copyp Val p=" ++ show pOld ++ ", pNew=" ++ show pNew ++ ", v=" ++ show (pp v)+ return pNew+ | otherwise = do+ -- putStrLn $ "GC copyp None p=" ++ show p+ return p++ -- inspect RVal_Ptr only+ copypv v = do+ case v of+ RVal_Ptr pref -> modifyIORefM pref copyp+ _ -> return ()++ -- inspect, possibly copy internal part of a RVal, stops with a ptr which later is dealt with (to prevent too deep stack growth), exploiting the in between grey/black area as queue+ copyv v = do+ -- putStrLn $ "GC copyv 1 v=" ++ show (pp v)+ case v of+ RVal_Ptr pref -> modifyIORefM pref copyp+ RVal_Module {rvalFrRef=frref} -> modifyIORefM frref copyp+ RVal_Frame {rvalCx=rcx, rvalFrVals=vs, rvalFrSP=spref}+ -> copycx rcx >> readIORef spref >>= \sp -> mvecForM_' 0 sp vs copyv+ RVal_NodeMV {rvalNdMVals=vs} -> mvecForM_ vs copyv+ RVal_App {rvalFun=f, rvalArgs=as} -> copyv f >> mvecForM_ as copyv+ RVal_Thunk {rvalCx=rcx} -> copycx rcx+ RVal_Lam {rvalCx=rcx} -> copycx rcx+ _ -> return ()+ -- putStrLn $ "GC copyv 2 v=" ++ show (pp v)++ -- inspect RCxt+ copycx cx = do+ case cx of+ RCxt mref slref -> modifyIORefM mref copyp >> modifyIORefM slref copyp++ -- inspect, follow, copy content of RVal+ follow pBlk pGry+ | pBlk < pGry = MV.read vsNew (pBlk-offNew) >>= copyv >> follow (pBlk+1) pGry+ | otherwise = do+ pGry' <- readIORef greyref+ if pBlk < pGry' then follow pBlk pGry' else return pBlk++ -- initial copy: top frame+ modifyIORefM topFrRef copyp --- $ \topFr -> {- if isNullPtr topFr then return topFr else -} copyp topFr++ -- initial copy: stack+ modifyIORefM stkRef $ mapM copyp++ -- initial copy: modules+ mvecLoop 0 (MV.length modules) (\v i -> MV.read v i >>= copyp >>= MV.write v i) modules++ -- initial copy: globals+ mvecLoop 0 (MV.length globals) (\v i -> MV.read v i >>= copyp >>= MV.write v i) globals++ -- initial copy: the RVal to be put on the heap+ copyv curV++ -- initial copy: additional roots+ readIORef rootStkRef >>= mapM_ (mapM_ copyv)++ -- follow with initial values of grey and black (0)+ readIORef greyref >>= follow offNew >>= \p -> writeIORef hpFrRef (p - offNew)++ -- final:+ return $ env { renvHeap = hp {hpVals=vsNew, hpFirst=offNew}}++ put env'+ -- rsemTr $ "GC done"+ -- rsemTr' True $ "GC done, curV=" >#< curV+ -- rsemSetTrace False+ return curV++{-# LINE 463 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | Allocate on the heap+heapAllocM :: (RunSem RValCxt RValEnv RVal m x) => RVal -> RValT m HpPtr+heapAllocM v = do+ hp@(Heap {hpVals=vs, hpFirst=off, hpFree=fr}) <- gets renvHeap+ p <- liftIO $ readIORef fr+ if p >= MV.length vs+ then heapGcM v >>= heapAllocM+ else liftIO $ do+ MV.write vs p v+ writeIORef fr (p + 1)+ return $ p + off++-- | Allocate on the heap, packing as RVal_Ptr+heapAllocAsPtrM :: (RunSem RValCxt RValEnv RVal m x) => RVal -> RValT m RVal+heapAllocAsPtrM v = do+ p <- heapAllocM v+ liftIO (newIORef p) >>= (return . RVal_Ptr)++{-+-}+-- | Get a value from the heap+-- heapGetM'' :: PrimMonad m => Heap -> HpPtr -> m RVal+heapGetM'' :: Heap -> HpPtr -> IO RVal+heapGetM'' hp@(Heap {hpVals=vs, hpFirst=off}) p = MV.read vs (p - off)+{-# INLINE heapGetM'' #-}++-- | Get a value from the heap+heapGetM' :: (RunSem RValCxt RValEnv RVal m x) => Heap -> HpPtr -> RValT m RVal+heapGetM' hp p = liftIO $ heapGetM'' hp p+{-# INLINE heapGetM' #-}++-- | Get a value from the heap+heapGetM :: (RunSem RValCxt RValEnv RVal m x) => HpPtr -> RValT m RVal+heapGetM p = do+ hp <- gets renvHeap+ heapGetM' hp p+{-# INLINE heapGetM #-}++-- | Set a value in the heap+heapSetM' :: (RunSem RValCxt RValEnv RVal m x) => Heap -> HpPtr -> RVal -> RValT m ()+heapSetM' hp@(Heap {hpVals=vs, hpFirst=off}) p v = liftIO $ MV.write vs (p - off) v+{-# INLINE heapSetM' #-}++-- | Set a value in the heap+heapSetM :: (RunSem RValCxt RValEnv RVal m x) => HpPtr -> RVal -> RValT m ()+heapSetM p v = do+ hp <- gets renvHeap+ heapSetM' hp p v+{-# INLINE heapSetM #-}++-- | Update a value in the heap+heapUpdM' :: (RunSem RValCxt RValEnv RVal m x) => Heap -> HpPtr -> (RVal -> RValT m RVal) -> RValT m ()+heapUpdM' hp@(Heap {hpVals=vs, hpFirst=off}) p f = do+ let p' = p - off+ v <- liftIO $ MV.read vs p'+ v' <- f v+ liftIO $ MV.write vs p' v'+{-# INLINE heapUpdM' #-}++-- | Update a value in the heap+heapUpdM :: (RunSem RValCxt RValEnv RVal m x) => HpPtr -> (RVal -> RValT m RVal) -> RValT m ()+heapUpdM p f = do+ hp <- gets renvHeap+ heapUpdM' hp p f+{-# INLINE heapUpdM #-}++{-# LINE 535 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | Mapping between constr name and tag+type RValDataconstrInfoNm2Tg = Map.Map String Int -- from constructor name to tag+type RValDataconstrInfoTg2Nm = CRArray String -- from tag to constructor Name++-- | Mapping between constr name and tag+data RValDataconstrInfo+ = RValDataconstrInfo+ { rdciNm2Tg :: RValDataconstrInfoNm2Tg -- from constructor name to tag+ , rdciTg2Nm :: RValDataconstrInfoTg2Nm -- from tag to constructor Name+ , rdciMods :: [HsName] -- modules (if any in which possibly multiple defs occur, >1 being an error when actually used)+ }+ deriving Show++emptyRValDataconstrInfo = RValDataconstrInfo Map.empty emptyCRArray []++-- | Mapping from type name to constr info+type RValDatatypeMp+ = Map.Map+ String -- type name+ RValDataconstrInfo -- data constr info++-- | Union+rvalDatatypeMpUnion :: RValDatatypeMp -> RValDatatypeMp -> RValDatatypeMp+rvalDatatypeMpUnion = Map.unionWith (\l r -> l {rdciMods = rdciMods l ++ rdciMods r})++-- | Unions+rvalDatatypeMpUnions1 :: [RValDatatypeMp] -> RValDatatypeMp+rvalDatatypeMpUnions1 = foldr1 rvalDatatypeMpUnion++-- | Extract datatype mapping from module+rvalDatatypeMpFromMod :: Mod -> RValDatatypeMp+rvalDatatypeMpFromMod (Mod_Mod {metas_Mod_Mod=metas})+ = Map.fromList+ [ ( show tn'+ , emptyRValDataconstrInfo+ { rdciNm2Tg = Map.fromList cts+ , rdciTg2Nm = crarrayFromList $ map fst $ sortOn snd cts+ , rdciMods = mods+ })+ | Meta_Data {tyNm_Meta_Data=tn, dataCons_Meta_Data=constrs} <- metas+ , let cts = assocLMapKey show $ candtg constrs+ (tn',mods) = splitTN tn+ ]+ where candtg cs = [ (cn,t) | DataCon_Con {conNm_DataCon_Con=cn, tagNr_DataCon_Con=t} <- cs ]+ splitTN n = (hsnQualified n, maybe [] (:[]) $ hsnQualifier n)++{-# LINE 591 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | Frame holding locals indexed by RRef_Loc+type RValFrame = HpPtr -- ^ points in heap to a RVal_Frame+type RValModule = HpPtr -- ^ points in heap to a RVal_Module++-- | Frame Stack+type RValStack = [RValFrame]++-- | Environment: state+data RValEnv+ = RValEnv+ { renvModulesMV :: !(CRMArray RValModule) -- ^ all modules+ , renvGlobalsMV :: !(CRMArray RValFrame) -- ^ per module frame of globals (will be obsolete)+ , renvStack :: !(IORef RValStack) -- ^ stack of frames, except for the top+ , renvTopFrame :: !(IORef RValFrame) -- ^ current frame, the actual top of the stack+ -- , renvFrSP :: !(IORef Int) -- ^ top of expr stack embedded in higher end of top frame+ , renvHeap :: !Heap -- ^ heap+ , renvDoTrace :: !Bool+ , renvDoTraceExt :: !Bool -- ^ when tracing, do it extensively?+ , renvGcRootStack :: !(IORef [[RVal]]) -- ^ stack of roots for GC, use is optional+ }++newRValEnv :: Int -> IO RValEnv+newRValEnv hpSz = do+ st <- newIORef []+ tp <- newIORef nullPtr+ hp <- newHeap hpSz+ rtst <- newIORef []+ md <- MV.new 0+ gl <- MV.new 0+ return $ RValEnv md gl st tp hp False False rtst++{-# LINE 624 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | Resolve module names into indirection/re-indexing table+renvResolveModNames :: (RunSem RValCxt RValEnv RVal m x) => [HsName] -> RValT m [Int]+renvResolveModNames nms = do+ env@(RValEnv {renvModulesMV=ms, renvHeap=hp}) <- get+ let lkup 0 nm = err $ "No module entry for: " ++ show nm+ lkup n nm = (liftIO $ MV.read ms n >>= heapGetM'' hp) >>= \(RVal_Module {rvalModNm=nm'}) -> if nm == nm' then return n else lkup (n-1) nm+ forM nms $ lkup (MV.length ms - 1)++{-# LINE 634 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | Get the top most frame ptr from the stack, 'nullPtr' if absent+renvTopFramePtrM :: (RunSem RValCxt RValEnv RVal m x) => RValT m HpPtr+renvTopFramePtrM = do+ (RValEnv {renvTopFrame=tf}) <- get+ liftIO $ readIORef tf+{-# INLINE renvTopFramePtrM #-}++-- | Get the top most frame ptr and frame from the stack, assuming a non 'nullPtr' ptr+renvTopFramePtrAndFrameM :: (RunSem RValCxt RValEnv RVal m x) => RValT m (HpPtr,RVal)+renvTopFramePtrAndFrameM = do+ frp <- renvTopFramePtrM+ fr <- heapGetM frp+ return (frp,fr)+{-# INLINE renvTopFramePtrAndFrameM #-}++-- | Get the top most frame from the stack, assuming a non 'nullPtr' ptr+renvTopFrameM :: (RunSem RValCxt RValEnv RVal m x) => RValT m RVal+renvTopFrameM = renvTopFramePtrM >>= heapGetM+{-# INLINE renvTopFrameM #-}++{-# LINE 656 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | Get all non empty stack frames, still split up in (possibly null) top frame and rest of stack+renvAllFrameM' :: (RunSem RValCxt RValEnv RVal m x) => RValT m (Maybe HpPtr,[HpPtr])+renvAllFrameM' = do+ topfrp <- renvTopFramePtrM+ env <- get+ st <- liftIO $ readIORef (renvStack env)+ return (if isNullPtr topfrp then Nothing else Just topfrp, st)++-- | Get all non empty stack frames+renvAllFrameM :: (RunSem RValCxt RValEnv RVal m x) => RValT m [HpPtr]+renvAllFrameM = do+ (mbtop,st) <- renvAllFrameM'+ return $ maybe [] (:[]) mbtop ++ st++{-# LINE 672 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | Dump environment+dumpPpEnvM :: (RunSem RValCxt RValEnv RVal m x) => Bool -> RValT m PP_Doc+dumpPpEnvM extensive = do+ stkfrs <- renvAllFrameM+ env <- get+ callcxt <- asks rcxtCallCxt+ let hp = renvHeap env+ stkfrspp <- forM stkfrs $ dumpFrameMinimal hp+ hpfr <- liftIO $ readIORef (hpFree hp)+ needRet <- asks rcxtInRet+ let dash = "===================="+ header1 = dash >-< "rcxtInRet=" >|< needRet+ header2 = ppCurly $ "Heap =" >|< hpfr >|< "/" >|< MV.length (hpVals hp) >|< ", CallCxt=" >|< ppBracketsCommas callcxt >|< ", Stack=" >|< ppBracketsCommas stkfrspp+ footer1 = dash+ hpPP <- dumpHeap hp hpfr+ glPP <- dumpGlobalsMV hp (renvGlobalsMV env)+ frPPs <- forM stkfrs $ dumpFrame hp+ if extensive+ then return $ header1 >-< header2 >-< hpPP >-< glPP >-< "====== Frames ======" >-< (indent 2 $ vlist frPPs) >-< footer1+ else return $ header2+ where+ dumpFrameMinimal hp fp = do+ fr@(RVal_Frame {rvalFrVals=vs, rvalFrSP=spref}) <- heapGetM fp+ sp <- liftIO $ readIORef spref+ return $ fp >|< (ppParens $ sp >|< "/" >|< MV.length vs)+ dumpFrame hp fp = do+ fr@(RVal_Frame {rvalFrVals=vs, rvalFrSP=spref}) <- heapGetM fp+ sp <- liftIO $ readIORef spref+ -- pps <- ppa 0 hp sp vs+ (liftIO $ ppRValWithHp hp fr) >>= \frpp -> return $ "Frame ptr=" >|< fp >|< " sp=" >|< sp >-< (indent 2 $ frpp) -- >-< (indent 2 $ vlist pps))+ dumpGlobalsMV hp glbls = do+ pps <- liftIO (mvecToList glbls) >>= \l -> forM l $ dumpFrame hp+ return $ "====== Globals ======" >-< indent 2 (vlist pps)+ dumpHeap hp@(Heap {hpFirst=off}) hpfr = do+ pps <- ppa off hp hpfr (hpVals hp)+ return $ "======= Heap =======" >-< indent 2 (vlist pps)+ ppb hp k v = (liftIO $ ppRValWithHp hp v) >>= \vpp -> return $ k >|< ":" >#< vpp+ ppa off hp sz vs = forM [0 .. sz - 1] $ \i -> liftIO (MV.read vs i) >>= ppb hp (i + off)++{-# LINE 713 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | Dump environment+dumpEnvM :: (RunSem RValCxt RValEnv RVal m x) => Bool -> RValT m ()+dumpEnvM extensive = dumpPpEnvM extensive >>= \p -> liftIO $ putPPLn p >> hFlush stdout++{-# LINE 723 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | RunT' variant for Val+type RValT m a = RunT' RValCxt RValEnv RVal m a+-- type RValT m a = RunT' () () RValEnv m a+++{-# LINE 734 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | Marshalling from/to Haskell values+class HSMarshall hs where+ -- | Marshall to Haskell value, also parameterized by evaluator+ hsMarshall :: (RunSem RValCxt RValEnv RVal m a) => (RVal -> RValT m a) -> RVal -> RValT m hs+ default hsMarshall :: (Generic hs, GHSMarshall (Rep hs), RunSem RValCxt RValEnv RVal m a) => (RVal -> RValT m a) -> RVal -> RValT m hs+ hsMarshall evl v = to <$> ghsMarshall evl v+ {-# INLINE hsMarshall #-}++ -- | Unmarshall from Haskell value+ hsUnmarshall :: (RunSem RValCxt RValEnv RVal m a) => hs -> RValT m a+ default hsUnmarshall :: (Generic hs, GHSMarshall (Rep hs), RunSem RValCxt RValEnv RVal m a) => hs -> RValT m a+ hsUnmarshall = ghsUnmarshall . from+ {-# INLINE hsUnmarshall #-}++{-# LINE 750 "src/ehc/CoreRun/Run/Val.chs" #-}+instance HSMarshall Int where+ hsMarshall _ (RVal_Int v) = return v+ hsMarshall _ v = err $ "CoreRun.Run.Val.HSMarshall Int:" >#< v+ hsUnmarshall v = rsemPush $ RVal_Int v+ {-# INLINE hsUnmarshall #-}++instance HSMarshall Int8 where+ hsMarshall _ (RVal_Int8 v) = return v+ hsMarshall _ v = err $ "CoreRun.Run.Val.HSMarshall Int8:" >#< v+ hsUnmarshall v = rsemPush $ RVal_Int8 v+ {-# INLINE hsUnmarshall #-}++instance HSMarshall Int16 where+ hsMarshall _ (RVal_Int16 v) = return v+ hsMarshall _ v = err $ "CoreRun.Run.Val.HSMarshall Int16:" >#< v+ hsUnmarshall v = rsemPush $ RVal_Int16 v+ {-# INLINE hsUnmarshall #-}++instance HSMarshall Int32 where+ hsMarshall _ (RVal_Int32 v) = return v+ hsMarshall _ v = err $ "CoreRun.Run.Val.HSMarshall Int32:" >#< v+ hsUnmarshall v = rsemPush $ RVal_Int32 v+ {-# INLINE hsUnmarshall #-}++instance HSMarshall Int64 where+ hsMarshall _ (RVal_Int64 v) = return v+ hsMarshall _ v = err $ "CoreRun.Run.Val.HSMarshall Int64:" >#< v+ hsUnmarshall v = rsemPush $ RVal_Int64 v+ {-# INLINE hsUnmarshall #-}++instance HSMarshall Word where+ hsMarshall _ (RVal_Word v) = return v+ hsMarshall _ v = err $ "CoreRun.Run.Val.HSMarshall Word:" >#< v+ hsUnmarshall v = rsemPush $ RVal_Word v+ {-# INLINE hsUnmarshall #-}++instance HSMarshall Word8 where+ hsMarshall _ (RVal_Word8 v) = return v+ hsMarshall _ v = err $ "CoreRun.Run.Val.HSMarshall Word8:" >#< v+ hsUnmarshall v = rsemPush $ RVal_Word8 v+ {-# INLINE hsUnmarshall #-}++instance HSMarshall Word16 where+ hsMarshall _ (RVal_Word16 v) = return v+ hsMarshall _ v = err $ "CoreRun.Run.Val.HSMarshall Word16:" >#< v+ hsUnmarshall v = rsemPush $ RVal_Word16 v+ {-# INLINE hsUnmarshall #-}++instance HSMarshall Word32 where+ hsMarshall _ (RVal_Word32 v) = return v+ hsMarshall _ v = err $ "CoreRun.Run.Val.HSMarshall Word32:" >#< v+ hsUnmarshall v = rsemPush $ RVal_Word32 v+ {-# INLINE hsUnmarshall #-}++instance HSMarshall Word64 where+ hsMarshall _ (RVal_Word64 v) = return v+ hsMarshall _ v = err $ "CoreRun.Run.Val.HSMarshall Word64:" >#< v+ hsUnmarshall v = rsemPush $ RVal_Word64 v+ {-# INLINE hsUnmarshall #-}++instance HSMarshall Integer where+ hsMarshall _ (RVal_Integer v) = return v+ hsMarshall _ v = err $ "CoreRun.Run.Val.HSMarshall Integer:" >#< v+ hsUnmarshall v = rsemPush $ RVal_Integer v+ {-# INLINE hsUnmarshall #-}++instance HSMarshall Float where+ hsMarshall _ (RVal_Float v) = return v+ hsMarshall _ v = err $ "CoreRun.Run.Val.HSMarshall Float:" >#< v+ hsUnmarshall v = rsemPush $ RVal_Float v+ {-# INLINE hsUnmarshall #-}++instance HSMarshall Double where+ hsMarshall _ (RVal_Double v) = return v+ hsMarshall _ v = err $ "CoreRun.Run.Val.HSMarshall Double:" >#< v+ hsUnmarshall v = rsemPush $ RVal_Double v+ {-# INLINE hsUnmarshall #-}++instance HSMarshall Char where+ hsMarshall _ (RVal_Char v) = return v+ hsMarshall _ v = err $ "CoreRun.Run.Val.HSMarshall Char:" >#< v+ hsUnmarshall v = rsemPush $ RVal_Char v+ {-# INLINE hsUnmarshall #-}++instance HSMarshall (Ptr a) where+ hsMarshall _ (RHsV_Addr v) = return $ Ptr v+ hsMarshall _ v = err $ "CoreRun.Run.Val.HSMarshall (Ptr a):" >#< v+ hsUnmarshall (Ptr v) = rsemPush $ RHsV_Addr v+ {-# INLINE hsUnmarshall #-}++instance HSMarshall Handle where+ hsMarshall _ (RHsV_Handle v) = return v+ hsMarshall _ v = err $ "CoreRun.Run.Val.HSMarshall Handle:" >#< v+ hsUnmarshall v = rsemPush $ RHsV_Handle v+ {-# INLINE hsUnmarshall #-}++{-# LINE 848 "src/ehc/CoreRun/Run/Val.chs" #-}+instance HSMarshall Bool++instance HSMarshall x => HSMarshall [x]++{-# LINE 854 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | Generic marshalling from/to Haskell values+class GHSMarshall hs where+ -- | Marshall to Haskell value, also parameterized by evaluator+ ghsMarshall :: (RunSem RValCxt RValEnv RVal m a) => (RVal -> RValT m a) -> RVal -> RValT m (hs x)++ -- | Unmarshall from Haskell value+ ghsUnmarshall :: (RunSem RValCxt RValEnv RVal m a) => hs x -> RValT m a++instance (Datatype d, MarshallSum hs) => GHSMarshall (D1 d hs) where+ --+ ghsMarshall evl v = do+ dtmp <- asks rcxtDatatypeMp+ let nm = datatypeName (undefined :: t d hs p)+ case Map.lookup nm dtmp of+ Nothing -> err $ "Marshall to HS lacks datatype info, datatype=" ++ nm+ Just (RValDataconstrInfo {rdciMods=mods@(_:_:_)}) ->+ err $ "Marshall to HS datatype info in multiple modules, datatype=" ++ nm ++ ", mods=" ++ show mods+ Just (RValDataconstrInfo {rdciTg2Nm=tg2con}) -> do+ r <- sumExtrTagged evl tg2con v+ maybe (err $ "sumExtrTagged") (return . M1) r+ --+ ghsUnmarshall (M1 x) = do+ dtmp <- asks rcxtDatatypeMp+ let nm = datatypeName (undefined :: t d hs p)+ case Map.lookup nm dtmp of+ Nothing -> err $ "Marshall from HS lacks datatype info, datatype=" ++ nm+ Just (RValDataconstrInfo {rdciMods=mods@(_:_:_)}) ->+ err $ "Marshall from HS datatype info in multiple modules, datatype=" ++ nm ++ ", mods=" ++ show mods+ Just (RValDataconstrInfo {rdciNm2Tg=con2tg}) ->+ sumFillTagged con2tg x++{-# LINE 887 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | Marshall util: extract values from sum+class MarshallSum hs where+ --+ sumFillTagged+ :: (RunSem RValCxt RValEnv RVal m a)+ => RValDataconstrInfoNm2Tg -- ^ mapping from constructor name to tag+ -> hs x -- ^ Haskell value+ -> RValT m a+ --+ sumExtrTagged+ :: (RunSem RValCxt RValEnv RVal m a)+ => (RVal -> RValT m a) -- ^ force evaluation for nested fields+ -> RValDataconstrInfoTg2Nm -- ^ mapping from constructor name to tag+ -> RVal -- ^ the 'RVal_NodeMV' holding tag and fields+ -> RValT m (Maybe (hs x))++instance ( MarshallProduct hs, ProductSize hs, Constructor c ) => MarshallSum (C1 c hs) where+ --+ sumFillTagged con2tg (M1 x) = do+ v <- liftIO $ MV.unsafeNew len+ productFillMVec v 0 len x+ let nm = conName (undefined :: t c hs p)+ mt = Map.lookup nm con2tg+ when (isNothing mt) $ err $ "Marshall from HS lacks constructor info, constructor=" ++ nm+ rsemNode (fromJust mt) v >>= rsemPush+ where+ len = (unTagged2 :: Tagged2 hs Int -> Int) productSize+ tag = Map.findWithDefault 0 (conName (undefined :: t c hs p)) con2tg+ {-# INLINE sumFillTagged #-}+ --+ sumExtrTagged evl tg2con v@(RVal_NodeMV {rvalTag=t, rvalNdMVals=mv})+ | t >= V.length tg2con = err $ "Marshall to HS illegal tag value, con=" ++ nmc ++ ", tag=" ++ show t+ | nmc == nmt = (Just . M1) <$> productExtrMVec evl mv 0 len+ | otherwise = return $ Nothing -- Left $ "Marshall to HS lacks constructor info, con=" ++ nmc ++ "/" ++ nmt ++ ", tag=" ++ show t+ where+ len = (unTagged2 :: Tagged2 hs Int -> Int) productSize+ nmc = conName (undefined :: t c hs p)+ nmt = tg2con V.! t+ {-# INLINE sumExtrTagged #-}++instance ( MarshallSum a, MarshallSum b ) => MarshallSum (a :+: b) where+ --+ sumFillTagged con2tg (L1 x) = sumFillTagged con2tg x+ sumFillTagged con2tg (R1 x) = sumFillTagged con2tg x+ {-# INLINE sumFillTagged #-}+ --+ -- sumExtrTagged evl tg2con v = (fmap L1 <$> sumExtrTagged evl tg2con v) <|> (fmap R1 <$> sumExtrTagged evl tg2con v)+ sumExtrTagged evl tg2con v = do+ l <- sumExtrTagged evl tg2con v+ case l of+ Just l' -> return $ fmap L1 l+ _ -> fmap R1 <$> sumExtrTagged evl tg2con v+ {-# INLINE sumExtrTagged #-}+++{-# LINE 944 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | Marshall util: extract values from product (inspired by Aeson library)+class MarshallProduct hs where+ -- | Fill vector from product+ productFillMVec+ :: (RunSem RValCxt RValEnv RVal m a)+ => CRMArray RVal -- ^ fields vector+ -> Int -- ^ index+ -> Int -- ^ length+ -> hs x -- ^ Haskell value+ -> RValT m ()+ -- | Extract product from vector+ productExtrMVec+ :: (RunSem RValCxt RValEnv RVal m a)+ => (RVal -> RValT m a) -- ^ force evaluation for nested fields+ -> CRMArray RVal -- ^ fields vector+ -> Int -- ^ index+ -> Int -- ^ length+ -> RValT m (hs x)++instance (MarshallProduct a, MarshallProduct b) => MarshallProduct (a :*: b) where+ productFillMVec mv ix len (a :*: b) = do+ productFillMVec mv ix lenL a+ productFillMVec mv ixR lenR b+ where+ lenL = len `unsafeShiftR` 1+ ixR = ix + lenL+ lenR = len - lenL+ {-# INLINE productFillMVec #-}++ productExtrMVec evl mv ix len =+ (:*:) <$> productExtrMVec evl mv ix lenL+ <*> productExtrMVec evl mv ixR lenR+ where+ lenL = len `unsafeShiftR` 1+ ixR = ix + lenL+ lenR = len - lenL+ {-# INLINE productExtrMVec #-}++instance MarshallProduct hs => MarshallProduct (S1 s hs) where+ productFillMVec mv ix l (M1 x) = productFillMVec mv ix l x+ {-# INLINE productFillMVec #-}++ productExtrMVec evl mv ix l = M1 <$> productExtrMVec evl mv ix l+ {-# INLINE productExtrMVec #-}++instance HSMarshall x => MarshallProduct (K1 i x) where+ productFillMVec mv ix _ (K1 x) = do+ x' <- rsemPop =<< hsUnmarshall x+ liftIO $ MV.unsafeWrite mv ix x'+ {-# INLINE productFillMVec #-}++ productExtrMVec evl mv ix _ = do+ v <- (liftIO $ MV.read mv ix) >>= evl >>= rsemPop+ K1 <$> hsMarshall evl v+ {-# INLINE productExtrMVec #-}++instance MarshallProduct U1 where+ productFillMVec mv ix _ U1 = return ()+ {-# INLINE productFillMVec #-}++ productExtrMVec evl mv ix _ = return U1+ {-# INLINE productExtrMVec #-}++{-# LINE 1009 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | Phantom type tagging (from Aeson lib)+newtype Tagged s b = Tagged {unTagged :: b}++-- | Phantom type tagging for higher kinds (from Aeson lib)+newtype Tagged2 (s :: * -> *) b = Tagged2 {unTagged2 :: b}++{-# LINE 1017 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | Size (nr of fields) of data type constructors (from Aeson lib)+class ProductSize f where+ productSize :: Tagged2 f Int++instance (ProductSize a, ProductSize b) => ProductSize (a :*: b) where+ productSize = Tagged2 $ unTagged2 (productSize :: Tagged2 a Int) ++ unTagged2 (productSize :: Tagged2 b Int)+ {-# INLINE productSize #-}++instance ProductSize (S1 s a) where+ productSize = Tagged2 1+ {-# INLINE productSize #-}++instance ProductSize U1 where+ productSize = Tagged2 0+ {-# INLINE productSize #-}++{-# LINE 1040 "src/ehc/CoreRun/Run/Val.chs" #-}+{-+-- | Loop over a vector, starting at lower bound 'l', ending before 'h'+vecLoop :: Monad m => Int -> Int -> (V.Vector a -> Int -> m b) -> V.Vector a -> m ()+vecLoop l h m v = loop l+ where loop l | l < h = m v l >> loop (l+1)+ | otherwise = return ()+{-# INLINE vecLoop #-}+-}++-- | Loop over a vector from upb to lwb, starting before 'h', ending at lower bound 'l'+vecLoopReverse :: Monad m => Int -> Int -> (V.Vector a -> Int -> m b) -> V.Vector a -> m ()+vecLoopReverse l h m v = loop (h-1)+ where loop h | l <= h = m v h >> loop (h-1)+ | otherwise = return ()+{-# INLINE vecLoopReverse #-}+++{-# LINE 1059 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | Right to left forM_+vecReverseForM_ :: Monad m => V.Vector a -> (a -> m x) -> m ()+vecReverseForM_ v m = vecLoopReverse 0 (V.length v) (\_ i -> m (v V.! i)) v+{-# INLINE vecReverseForM_ #-}++{-# LINE 1070 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | Allocate a mutable vector of given size+mvecAllocWith :: PrimMonad m => Int -> a -> m (MV.MVector (PrimState m) a)+mvecAllocWith = MV.replicate+{-# INLINE mvecAllocWith #-}++-- | Allocate a mutable vector of given size, init to default value+mvecAllocInit :: Int -> IO RValMV+mvecAllocInit sz = mvecAllocWith sz RVal_None+{-# INLINE mvecAllocInit #-}++-- | Allocate a mutable vector of given size+mvecAlloc :: PrimMonad m => Int -> m (MV.MVector (PrimState m) a)+mvecAlloc = MV.new+{-# INLINE mvecAlloc #-}++-- | Loop over a mutable vector, updating the vector as a side effect, starting at lower bound 'l', ending before 'h'+mvecLoop :: PrimMonad m => Int -> Int -> (MV.MVector (PrimState m) a -> Int -> m b) -> MV.MVector (PrimState m) a -> m (MV.MVector (PrimState m) a)+mvecLoop l h m v = loop l+ where loop l | l < h = m v l >> loop (l+1)+ | otherwise = return v+{-# INLINE mvecLoop #-}++-- | Loop over a mutable vector from upb to lwb, updating the vector as a side effect, starting before 'h', ending at lower bound 'l'+mvecLoopReverse :: PrimMonad m => Int -> Int -> (MV.MVector (PrimState m) a -> Int -> m b) -> MV.MVector (PrimState m) a -> m (MV.MVector (PrimState m) a)+mvecLoopReverse l h m v = loop (h-1)+ where loop h | l <= h = m v h >> loop (h-1)+ | otherwise = return v+{-# INLINE mvecLoopReverse #-}++-- | Loop over a mutable vector from upb to lwb, updating the vector as a side effect, starting before 'h', ending at lower bound 'l'+mvecLoopReverseAccum :: PrimMonad m => acc -> Int -> Int -> (acc -> Int -> m acc) -> MV.MVector (PrimState m) a -> m acc+mvecLoopReverseAccum a l h m v = loop (h-1) a+ where loop h a | l <= h = m a h >>= loop (h-1)+ | otherwise = return a+{-# INLINE mvecLoopReverseAccum #-}++-- | Convert to a list+mvecToList :: PrimMonad m => MV.MVector (PrimState m) a -> m [a]+mvecToList v = mvecLoopReverseAccum [] 0 (MV.length v) (\l i -> MV.read v i >>= \a -> return (a:l)) v++-- | Fill a mutable vector from a unmutable vector, starting with filling at the given lowerbound+mvecFillFromV :: PrimMonad m => Int -> MV.MVector (PrimState m) a -> CRArray a -> m ()+mvecFillFromV lwb toarr frarr = forM_ (craAssocs' lwb frarr) $ \(i,e) -> MV.write toarr i e+{-# INLINE mvecFillFromV #-}++-- | Fill a mutable vector from a unmutable vector, starting with filling at the given lowerbound, reversing the given vector+mvecReverseFillFromV :: PrimMonad m => Int -> MV.MVector (PrimState m) a -> CRArray a -> m ()+mvecReverseFillFromV lwb toarr frarr = forM_ (craReverseAssocs' lwb frarr) $ \(i,e) -> MV.write toarr i e+{-# INLINE mvecReverseFillFromV #-}++-- | Fill a mutable vector from another mutable vector, starting with copying at the given lowerbounds, copying size elements+mvecFillFromMV' :: PrimMonad m => Int -> Int -> Int -> MV.MVector (PrimState m) a -> MV.MVector (PrimState m) a -> m ()+mvecFillFromMV' lwbTo lwbFr sz toarr frarr = mvecLoop lwbFr (lwbFr+sz) (\v i -> MV.read v i >>= MV.write toarr (i+lwbDiff)) frarr >> return ()+ where lwbDiff = lwbTo - lwbFr+{-# INLINE mvecFillFromMV' #-}++-- | Fill a mutable vector from another mutable vector, starting with copying at the given lowerbounds, copying size elements, but reversing the given vector+mvecReverseFillFromMV' :: PrimMonad m => Int -> Int -> Int -> MV.MVector (PrimState m) a -> MV.MVector (PrimState m) a -> m ()+-- mvecReverseFillFromMV' lwbTo lwbFr sz toarr frarr = mvecLoop lwbFr (lwbFr+sz) (\v i -> MV.read v (upbFr1-i) >>= MV.write toarr (i+lwbDiff)) frarr >> return ()+mvecReverseFillFromMV' lwbTo lwbFr sz toarr frarr = mvecLoopReverse lwbFr (lwbFr+sz) (\v i -> MV.read v i >>= MV.write toarr (upbFr1 - i + lwbTo)) frarr >> return ()+ where lwbDiff = lwbTo - lwbFr+ upbFr1 = lwbFr + sz - 1+{-# INLINE mvecReverseFillFromMV' #-}++-- | Fill a mutable vector from another mutable vector, starting with filling at the given lowerbound+mvecFillFromMV :: PrimMonad m => Int -> MV.MVector (PrimState m) a -> MV.MVector (PrimState m) a -> m ()+-- mvecFillFromMV lwb toarr frarr = mvecLoop 0 (MV.length frarr) (\v i -> MV.read frarr i >>= MV.write toarr (i+lwb)) frarr >> return ()+mvecFillFromMV lwb toarr frarr = mvecFillFromMV' lwb 0 (MV.length frarr) toarr frarr+{-# INLINE mvecFillFromMV #-}+-- {-# SPECIALIZE mvecFillFromMV :: Int -> MV.MVector (PrimState IO) a -> MV.MVector (PrimState IO) a -> IO () #-}++-- | Fill a mutable vector from another mutable vector, starting with filling at the given lowerbound, but reversing the given vector+mvecReverseFillFromMV :: PrimMonad m => Int -> MV.MVector (PrimState m) a -> MV.MVector (PrimState m) a -> m ()+mvecReverseFillFromMV lwb toarr frarr = mvecReverseFillFromMV' lwb 0 (MV.length frarr) toarr frarr+{-+mvecReverseFillFromMV lwb toarr frarr = mvecLoop 0 l (\v i -> MV.read frarr (l1-i) >>= MV.write toarr (i+lwb)) frarr >> return ()+ where l = MV.length frarr+ l1 = l - 1+-}+{-# INLINE mvecReverseFillFromMV #-}++-- | Alloc and fill vector of size taken from fixed vec+mvecAllocFillFromV :: PrimMonad m => CRArray a -> m (MV.MVector (PrimState m) a)+mvecAllocFillFromV frarr = mvecAlloc (V.length frarr) >>= \toarr -> mvecFillFromV 0 toarr frarr >> return toarr+{-# INLINE mvecAllocFillFromV #-}++-- | Loop over a mutable vector, updating the vector as a side effect, with explicit range+mvecForM_' :: PrimMonad m => Int -> Int -> MV.MVector (PrimState m) a -> (a -> m b) -> m ()+mvecForM_' lwb upb v m = mvecLoop lwb upb (\v i -> MV.read v i >>= m) v >> return ()+{-# INLINE mvecForM_' #-}++-- | Loop over a mutable vector, updating the vector as a side effect+mvecForM_ :: PrimMonad m => MV.MVector (PrimState m) a -> (a -> m b) -> m ()+mvecForM_ v m = mvecForM_' 0 (MV.length v) v m+{-# INLINE mvecForM_ #-}++-- | Append mutable 2 vectors+mvecAppend :: PrimMonad m => MV.MVector (PrimState m) a -> MV.MVector (PrimState m) a -> m (MV.MVector (PrimState m) a)+mvecAppend v1 v2 =+ mvecAlloc l12 >>= mvecLoop 0 l1 (\v i -> MV.read v1 i >>= MV.write v i) >>= mvecLoop l1 l12 (\v i -> MV.read v2 (i-l1) >>= MV.write v i)+ where+ l1 = MV.length v1+ l2 = MV.length v2+ l12 = l1 + l2++{-# LINE 1177 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | Right to left forM_+mvecReverseForM_ :: PrimMonad m => MV.MVector (PrimState m) a -> (a -> m x) -> m ()+mvecReverseForM_ v m = mvecLoopReverse 0 (MV.length v) (\v i -> MV.read v i >>= m) v >> return ()+{-# INLINE mvecReverseForM_ #-}++{-# LINE 1188 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | Dereference a possibly RVal_Ptr+ptr2valM :: (RunSem RValCxt RValEnv RVal m x) => RVal -> RValT m RVal+ptr2valM v = case v of+ RVal_Ptr pref -> liftIO (readIORef pref) >>= heapGetM >>= \v' -> case v' of+ RVal_Thunk {} -> return v+ _ -> ptr2valM v'+ _ -> return v+{-# INLINE ptr2valM #-}++-- | Dereference a RRef+ref2valM :: (RunSem RValCxt RValEnv RVal m x) => RRef -> RValT m RVal+ref2valM r = do+ -- rsemTr $ "R: " ++ show (pp r)+ env@(RValEnv {renvHeap=hp, renvModulesMV=mods}) <- get+ case r of+ RRef_Glb m e -> do+ RVal_Frame {rvalFrVals=frvals} <- heapGetM =<< liftIO (MV.read (renvGlobalsMV env) m)+ liftIO $ MV.read frvals e+ RRef_Imp m e -> do+ RVal_Frame {rvalCx=RCxt {rcxtMdRef=mdref}} <- renvTopFrameM+ liftIO $ do+ RVal_Module {rvalModImpsV=imps} <- heapGetM'' hp =<< readIORef mdref+ RVal_Frame {rvalFrVals=frvals} <- heapGetM'' hp =<< MV.read mods (imps V.! m)+ MV.read frvals e+ RRef_Mod e -> do+ RVal_Frame {rvalCx=RCxt {rcxtMdRef=mdref}} <- renvTopFrameM+ liftIO $ do+ RVal_Module {rvalFrRef=frref} <- heapGetM'' hp =<< readIORef mdref+ RVal_Frame {rvalFrVals=frvals} <- heapGetM'' hp =<< readIORef frref+ MV.read frvals e+{-+ RRef_Loc l o -> do+ topfrp <- renvTopFramePtrM+ topfr <- heapGetM topfrp+ access topfr+ where+ access (RVal_Frame {rvalLev=frlev, rvalFrVals=vs}) | l == frlev = do+ -- rsemTr $ "R o=" ++ show o ++ " len(vs)=" ++ show (MV.length vs)+ liftIO $ MV.read vs o+ access (RVal_Frame {rvalLev=frlev, rvalCx=slref}) = do+ sl <- liftIO $ readIORef slref+ -- rsemTr $ "R sl=" ++ show sl ++ " frlev=" ++ show frlev ++ " l=" ++ show l+ heapGetM sl >>= access+ access v =+ err $ "CoreRun.Run.Val.ref2valM.RRef_Loc.access:" >#< r >#< "in" >#< v+-}+ RRef_LDf ld o -> do+ topfr <- renvTopFrameM+ access ld topfr+ where+ access 0 (RVal_Frame {rvalFrVals=vs}) =+ liftIO $ MV.read vs o+ access ld (RVal_Frame {rvalCx=rcx}) = do+ sl <- liftIO $ readIORef (rcxtSlRef rcx)+ fr <- heapGetM sl+ access (ld-1) fr+ access _ v =+ err $ "CoreRun.Run.Val.ref2valM.RRef_LDf.access:" >#< r >#< "in" >#< v+ RRef_Fld r e -> do+ v <- ptr2valM =<< ref2valM r -- >>= rsemDeref+ case v of+ RVal_NodeMV _ vs -> liftIO $ MV.read vs e+ _ -> err $ "CoreRun.Run.Val.ref2valM.RRef_Fld:" >#< e >#< "in" >#< v+ RRef_Tag r -> do+ v <- ptr2valM =<< ref2valM r -- >>= rsemDeref+ case v of+ RVal_NodeMV t _ -> return $ RVal_Int t+ _ -> err $ "CoreRun.Run.Val.ref2valM.RRef_Tag:" >#< v+ _ -> err $ "CoreRun.Run.Val.ref2valM.r:" >#< r+{-# INLINE ref2valM #-}++{-# LINE 1266 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | Update top frame+updTopFrameM :: (RunSem RValCxt RValEnv RVal m x) => (RVal -> RValT m RVal) -> RValT m ()+updTopFrameM f = renvTopFramePtrM >>= flip heapUpdM f+{-# INLINE updTopFrameM #-}++{-# LINE 1278 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | Push on the stack embedded in the top frame+renvFrStkPush' :: RunSem RValCxt RValEnv RVal m x => (Int -> RValMV -> v -> IO Int) -> v -> RValT m ()+renvFrStkPush' pushvOn v = do+ (RValEnv {renvTopFrame=frref, renvHeap=hp}) <- get+ liftIO $ do+ (RVal_Frame {rvalFrVals=frvs, rvalFrSP=spref}) <- heapGetM'' hp =<< readIORef frref+ sp <- readIORef spref+ sp' <- pushvOn sp frvs v+ writeIORef spref sp'++-- | Push on the stack embedded in the top frame+renvFrStkPush1 :: RunSem RValCxt RValEnv RVal m x => RVal -> RValT m ()+renvFrStkPush1 = renvFrStkPush' (\sp frvs v -> MV.write frvs sp v >> return (sp + 1))+{-# INLINE renvFrStkPush1 #-}++-- | Push on the stack embedded in the top frame+renvFrStkPushMV :: RunSem RValCxt RValEnv RVal m x => RValMV -> RValT m ()+renvFrStkPushMV = renvFrStkPush' (\sp frvs vs -> mvecFillFromMV sp frvs vs >> return (sp + MV.length vs))+{-# INLINE renvFrStkPushMV #-}++-- | Push reversed on the stack embedded in the top frame+renvFrStkReversePushMV :: RunSem RValCxt RValEnv RVal m x => RValMV -> RValT m ()+renvFrStkReversePushMV = renvFrStkPush' (\sp frvs vs -> mvecReverseFillFromMV sp frvs vs >> return (sp + MV.length vs))+{-# INLINE renvFrStkReversePushMV #-}++-- | Push on the stack embedded in the top frame+renvFrStkPushV :: RunSem RValCxt RValEnv RVal m x => RValV -> RValT m ()+renvFrStkPushV = renvFrStkPush' (\sp frvs vs -> mvecFillFromV sp frvs vs >> return (sp + V.length vs))+{-# INLINE renvFrStkPushV #-}++-- | Push reversed on the stack embedded in the top frame+renvFrStkReversePushV :: RunSem RValCxt RValEnv RVal m x => RValV -> RValT m ()+renvFrStkReversePushV = renvFrStkPush' (\sp frvs vs -> mvecReverseFillFromV sp frvs vs >> return (sp + V.length vs))+{-# INLINE renvFrStkReversePushV #-}++{-# LINE 1315 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | Pop from the stack embedded in the top frame+renvFrStkPop' :: RunSem RValCxt RValEnv RVal m x => (RValMV -> Int -> IO v) -> Int -> RValT m v+renvFrStkPop' popvFrom sz = do+ (RValEnv {renvTopFrame=frref, renvHeap=hp}) <- get+ liftIO $ do+ (RVal_Frame {rvalFrVals=frvs, rvalFrSP=spref}) <- heapGetM'' hp =<< readIORef frref+ sp <- readIORef spref+ let sp' = sp - sz+ writeIORef spref sp'+ popvFrom frvs sp'++-- | Pop from the stack embedded in the top frame+renvFrStkPop :: RunSem RValCxt RValEnv RVal m x => Int -> RValT m ()+renvFrStkPop = renvFrStkPop' (\_ _ -> return ())+{-# INLINE renvFrStkPop #-}++-- | Pop from the stack embedded in the top frame+renvFrStkPop1 :: RunSem RValCxt RValEnv RVal m x => RValT m RVal+renvFrStkPop1 = renvFrStkPop' MV.read 1+{-# INLINE renvFrStkPop1 #-}++-- | Pop from the stack embedded in the top frame+renvFrStkPopInMV :: RunSem RValCxt RValEnv RVal m x => Int -> Int -> RValMV -> RValT m ()+renvFrStkPopInMV lwbTo sz vs = renvFrStkPop' (\frvs sp -> mvecFillFromMV' lwbTo sp sz vs frvs) sz+{-# INLINE renvFrStkPopInMV #-}++-- | Pop from the stack embedded in the top frame+renvFrStkPopMV :: RunSem RValCxt RValEnv RVal m x => Int -> RValT m RValMV+-- renvFrStkPopMV sz = renvFrStkPop' (\frvs sp -> mvecAlloc sz >>= \vs -> mvecFillFromMV' 0 sp sz vs frvs >> return vs) sz+renvFrStkPopMV sz = (liftIO $ mvecAlloc sz) >>= \vs -> renvFrStkPopInMV 0 sz vs >> return vs+{-# INLINE renvFrStkPopMV #-}++-- | Pop from the stack embedded in the top frame+renvFrStkReversePopInMV :: RunSem RValCxt RValEnv RVal m x => Int -> Int -> RValMV -> RValT m ()+renvFrStkReversePopInMV lwbTo sz vs = renvFrStkPop' (\frvs sp -> mvecReverseFillFromMV' lwbTo sp sz vs frvs) sz+{-# INLINE renvFrStkReversePopInMV #-}++-- | Pop from the stack embedded in the top frame+renvFrStkReversePopMV :: RunSem RValCxt RValEnv RVal m x => Int -> RValT m RValMV+-- renvFrStkReversePopMV sz = renvFrStkPop' (\frvs sp -> mvecAlloc sz >>= \vs -> mvecReverseFillFromMV' 0 sp sz vs frvs >> return vs) sz+renvFrStkReversePopMV sz = (liftIO $ mvecAlloc sz) >>= \vs -> renvFrStkReversePopInMV 0 sz vs >> return vs+{-# INLINE renvFrStkReversePopMV #-}++{-# LINE 1364 "src/ehc/CoreRun/Run/Val.chs" #-}+-- | Trace+rsemTr' :: (PP msg, RunSem RValCxt RValEnv RVal m x) => Bool -> msg -> RValT m ()+rsemTr' dumpExtensive msg = do+ env <- get+ when (renvDoTrace env) $ do+ liftIO $ putStrLn $ show $ pp msg+ dumpEnvM (dumpExtensive || renvDoTraceExt env)+ liftIO $ hFlush stdout+{- INLINE rsemTr' #-}++-- | Trace+rsemTr :: (PP msg, RunSem RValCxt RValEnv RVal m x) => msg -> RValT m ()+rsemTr = rsemTr' False+{- INLINE rsemTr #-}
@@ -12,9 +12,11 @@ import qualified Data.Vector as V import qualified Data.Vector.Mutable as MV import qualified Data.ByteString.Char8 as BSC8+import Data.Bits+import Data.Maybe import GHC.Generics -{-# LINE 38 "src/ehc/CoreRun/Run/Val/Prim.chs" #-}+{-# LINE 40 "src/ehc/CoreRun/Run/Val/Prim.chs" #-} -- | Apply primitive to arguments rvalPrim :: (RunSem RValCxt RValEnv RVal m a) => RunPrim -> RValV -> RValT m a rvalPrim pr as = do@@ -26,61 +28,74 @@ (RP_primUnsafeId, [x]) -> rsemPush x -- Char- (RP_primEqChar, [RVal_Char i1, RVal_Char i2]) -> hsUnmarshall $ i1 == i2- (RP_primCmpChar, [RVal_Char i1, RVal_Char i2]) -> hsUnmarshall $ i1 `compare` i2+ (RP_primEqChar , [RVal_Char i1, RVal_Char i2] ) -> hsUnmarshall $ i1 == i2+ (RP_primCmpChar , [RVal_Char i1, RVal_Char i2] ) -> hsUnmarshall $ i1 `compare` i2 - (RP_primCharToInt , [RVal_Char x]) -> rsemPush $ RVal_Int $ fromEnum x- (RP_primIntToChar , [RVal_Int x]) -> rsemPush $ RVal_Char $ toEnum x+ (RP_primCharToInt , [RVal_Char x] ) -> rsemPush $ RVal_Int $ fromEnum x+ (RP_primIntToChar , [RVal_Int x] ) -> rsemPush $ RVal_Char $ toEnum x -- Int- (RP_primAddInt, [RVal_Int i1, RVal_Int i2]) -> rsemPush $ RVal_Int $ i1 + i2- (RP_primSubInt, [RVal_Int i1, RVal_Int i2]) -> rsemPush $ RVal_Int $ i1 - i2- (RP_primMulInt, [RVal_Int i1, RVal_Int i2]) -> rsemPush $ RVal_Int $ i1 * i2- (RP_primDivInt, [RVal_Int i1, RVal_Int i2]) -> rsemPush $ RVal_Int $ i1 `div` i2- (RP_primQuotInt, [RVal_Int i1, RVal_Int i2]) -> rsemPush $ RVal_Int $ i1 `quot` i2- (RP_primRemInt, [RVal_Int i1, RVal_Int i2]) -> rsemPush $ RVal_Int $ i1 `rem` i2- (RP_primModInt, [RVal_Int i1, RVal_Int i2]) -> rsemPush $ RVal_Int $ i1 `mod` i2- (RP_primNegInt, [RVal_Int i1]) -> rsemPush $ RVal_Int (-i1)+ (RP_primAddInt , [RVal_Int i1, RVal_Int i2]) -> rsemPush $ RVal_Int $ i1 + i2+ (RP_primSubInt , [RVal_Int i1, RVal_Int i2]) -> rsemPush $ RVal_Int $ i1 - i2+ (RP_primMulInt , [RVal_Int i1, RVal_Int i2]) -> rsemPush $ RVal_Int $ i1 * i2+ (RP_primDivInt , [RVal_Int i1, RVal_Int i2]) -> rsemPush $ RVal_Int $ i1 `div` i2+ (RP_primQuotInt , [RVal_Int i1, RVal_Int i2]) -> rsemPush $ RVal_Int $ i1 `quot` i2+ (RP_primRemInt , [RVal_Int i1, RVal_Int i2]) -> rsemPush $ RVal_Int $ i1 `rem` i2+ (RP_primModInt , [RVal_Int i1, RVal_Int i2]) -> rsemPush $ RVal_Int $ i1 `mod` i2+ (RP_primNegInt , [RVal_Int i1] ) -> rsemPush $ RVal_Int (-i1) - (RP_primDivModInt, [RVal_Int i1, RVal_Int i2]) -> hsUnmarshall $ i1 `divMod` i2- (RP_primQuotRemInt, [RVal_Int i1, RVal_Int i2]) -> hsUnmarshall $ i1 `quotRem` i2+ (RP_primDivModInt , [RVal_Int i1, RVal_Int i2]) -> hsUnmarshall $ i1 `divMod` i2+ (RP_primQuotRemInt , [RVal_Int i1, RVal_Int i2]) -> hsUnmarshall $ i1 `quotRem` i2 - (RP_primMinInt, []) -> rsemPush $ RVal_Int minBound- (RP_primMaxInt, []) -> rsemPush $ RVal_Int maxBound+ (RP_primMinInt , [] ) -> rsemPush $ RVal_Int minBound+ (RP_primMaxInt , [] ) -> rsemPush $ RVal_Int maxBound - (RP_primEqInt, [RVal_Int i1, RVal_Int i2]) -> hsUnmarshall $ i1 == i2- (RP_primNeInt, [RVal_Int i1, RVal_Int i2]) -> hsUnmarshall $ i1 /= i2+ (RP_primEqInt , [RVal_Int i1, RVal_Int i2]) -> hsUnmarshall $ i1 == i2+ (RP_primNeInt , [RVal_Int i1, RVal_Int i2]) -> hsUnmarshall $ i1 /= i2 - (RP_primCmpInt, [RVal_Int i1, RVal_Int i2]) -> hsUnmarshall $ i1 `compare` i2- (RP_primLeInt, [RVal_Int i1, RVal_Int i2]) -> hsUnmarshall $ i1 <= i2- (RP_primLtInt, [RVal_Int i1, RVal_Int i2]) -> hsUnmarshall $ i1 < i2- (RP_primGeInt, [RVal_Int i1, RVal_Int i2]) -> hsUnmarshall $ i1 >= i2- (RP_primGtInt, [RVal_Int i1, RVal_Int i2]) -> hsUnmarshall $ i1 > i2+ (RP_primCmpInt , [RVal_Int i1, RVal_Int i2]) -> hsUnmarshall $ i1 `compare` i2+ (RP_primLeInt , [RVal_Int i1, RVal_Int i2]) -> hsUnmarshall $ i1 <= i2+ (RP_primLtInt , [RVal_Int i1, RVal_Int i2]) -> hsUnmarshall $ i1 < i2+ (RP_primGeInt , [RVal_Int i1, RVal_Int i2]) -> hsUnmarshall $ i1 >= i2+ (RP_primGtInt , [RVal_Int i1, RVal_Int i2]) -> hsUnmarshall $ i1 > i2 - (RP_primIntToInteger , [RVal_Int x]) -> rsemPush $ RVal_Integer $ fromIntegral x- (RP_primIntegerToInt , [RVal_Integer x]) -> rsemPush $ RVal_Int $ fromIntegral x+ (RP_primAndInt , [RVal_Int i1, RVal_Int i2]) -> rsemPush $ RVal_Int $ i1 .&. i2+ (RP_primOrInt , [RVal_Int i1, RVal_Int i2]) -> rsemPush $ RVal_Int $ i1 .|. i2+ (RP_primXorInt , [RVal_Int i1, RVal_Int i2]) -> rsemPush $ RVal_Int $ i1 `xor` i2+ (RP_primComplementInt , [RVal_Int i1] ) -> rsemPush $ RVal_Int $ complement i1+ (RP_primShiftLeftInt , [RVal_Int i1, RVal_Int i2]) -> rsemPush $ RVal_Int $ i1 `shiftL` i2+ (RP_primShiftRightInt , [RVal_Int i1, RVal_Int i2]) -> rsemPush $ RVal_Int $ i1 `shiftR` i2+ (RP_primRotateLeftInt , [RVal_Int i1, RVal_Int i2]) -> rsemPush $ RVal_Int $ i1 `rotateL` i2+ (RP_primRotateRightInt, [RVal_Int i1, RVal_Int i2]) -> rsemPush $ RVal_Int $ i1 `rotateR` i2+ (RP_primBitSize , [RVal_Int i1] ) -> rsemPush $ RVal_Int $ fromJust $ bitSizeMaybe i1+ (RP_primBitSizeMaybe , [RVal_Int i1] ) -> hsUnmarshall $ bitSizeMaybe i1+ (RP_primPopCount , [RVal_Int i1] ) -> rsemPush $ RVal_Int $ popCount i1+ (RP_primBit , [RVal_Int i1] ) -> rsemPush $ RVal_Int $ bit i1 + (RP_primIntToInteger , [RVal_Int x] ) -> rsemPush $ RVal_Integer $ fromIntegral x+ (RP_primIntegerToInt , [RVal_Integer x] ) -> rsemPush $ RVal_Int $ fromIntegral x+ -- Integer- (RP_primAddInteger, [RVal_Integer i1, RVal_Integer i2]) -> rsemPush $ RVal_Integer $ i1 + i2- (RP_primSubInteger, [RVal_Integer i1, RVal_Integer i2]) -> rsemPush $ RVal_Integer $ i1 - i2- (RP_primMulInteger, [RVal_Integer i1, RVal_Integer i2]) -> rsemPush $ RVal_Integer $ i1 * i2- (RP_primDivInteger, [RVal_Integer i1, RVal_Integer i2]) -> rsemPush $ RVal_Integer $ i1 `div` i2- (RP_primQuotInteger, [RVal_Integer i1, RVal_Integer i2]) -> rsemPush $ RVal_Integer $ i1 `quot` i2- (RP_primRemInteger, [RVal_Integer i1, RVal_Integer i2]) -> rsemPush $ RVal_Integer $ i1 `rem` i2- (RP_primModInteger, [RVal_Integer i1, RVal_Integer i2]) -> rsemPush $ RVal_Integer $ i1 `mod` i2- (RP_primNegInteger, [RVal_Integer i1]) -> rsemPush $ RVal_Integer (-i1)+ (RP_primAddInteger , [RVal_Integer i1, RVal_Integer i2]) -> rsemPush $ RVal_Integer $ i1 + i2+ (RP_primSubInteger , [RVal_Integer i1, RVal_Integer i2]) -> rsemPush $ RVal_Integer $ i1 - i2+ (RP_primMulInteger , [RVal_Integer i1, RVal_Integer i2]) -> rsemPush $ RVal_Integer $ i1 * i2+ (RP_primDivInteger , [RVal_Integer i1, RVal_Integer i2]) -> rsemPush $ RVal_Integer $ i1 `div` i2+ (RP_primQuotInteger , [RVal_Integer i1, RVal_Integer i2]) -> rsemPush $ RVal_Integer $ i1 `quot` i2+ (RP_primRemInteger , [RVal_Integer i1, RVal_Integer i2]) -> rsemPush $ RVal_Integer $ i1 `rem` i2+ (RP_primModInteger , [RVal_Integer i1, RVal_Integer i2]) -> rsemPush $ RVal_Integer $ i1 `mod` i2+ (RP_primNegInteger , [RVal_Integer i1] ) -> rsemPush $ RVal_Integer (-i1) - (RP_primDivModInteger, [RVal_Integer i1, RVal_Integer i2]) -> hsUnmarshall $ i1 `divMod` i2- (RP_primQuotRemInteger, [RVal_Integer i1, RVal_Integer i2]) -> hsUnmarshall $ i1 `quotRem` i2+ (RP_primDivModInteger , [RVal_Integer i1, RVal_Integer i2]) -> hsUnmarshall $ i1 `divMod` i2+ (RP_primQuotRemInteger , [RVal_Integer i1, RVal_Integer i2]) -> hsUnmarshall $ i1 `quotRem` i2 - (RP_primEqInteger, [RVal_Integer i1, RVal_Integer i2]) -> hsUnmarshall $ i1 == i2- (RP_primNeInteger, [RVal_Integer i1, RVal_Integer i2]) -> hsUnmarshall $ i1 /= i2+ (RP_primEqInteger , [RVal_Integer i1, RVal_Integer i2]) -> hsUnmarshall $ i1 == i2+ (RP_primNeInteger , [RVal_Integer i1, RVal_Integer i2]) -> hsUnmarshall $ i1 /= i2 - (RP_primCmpInteger, [RVal_Integer i1, RVal_Integer i2]) -> hsUnmarshall $ i1 `compare` i2- (RP_primLeInteger, [RVal_Integer i1, RVal_Integer i2]) -> hsUnmarshall $ i1 <= i2- (RP_primLtInteger, [RVal_Integer i1, RVal_Integer i2]) -> hsUnmarshall $ i1 < i2- (RP_primGeInteger, [RVal_Integer i1, RVal_Integer i2]) -> hsUnmarshall $ i1 >= i2- (RP_primGtInteger, [RVal_Integer i1, RVal_Integer i2]) -> hsUnmarshall $ i1 > i2+ (RP_primCmpInteger , [RVal_Integer i1, RVal_Integer i2]) -> hsUnmarshall $ i1 `compare` i2+ (RP_primLeInteger , [RVal_Integer i1, RVal_Integer i2]) -> hsUnmarshall $ i1 <= i2+ (RP_primLtInteger , [RVal_Integer i1, RVal_Integer i2]) -> hsUnmarshall $ i1 < i2+ (RP_primGeInteger , [RVal_Integer i1, RVal_Integer i2]) -> hsUnmarshall $ i1 >= i2+ (RP_primGtInteger , [RVal_Integer i1, RVal_Integer i2]) -> hsUnmarshall $ i1 > i2 -- Exception handling (RP_primCatchException, [x, hdl]) -> rsemEvl x -- err $ "Not impl: RP_primCatchException" -- TBD@@ -259,7 +274,7 @@ (pr, _) -> err $ "CoreRun.Run.Val.Prim:" >#< show pr -{-# LINE 288 "src/ehc/CoreRun/Run/Val/Prim.chs" #-}+{-# LINE 303 "src/ehc/CoreRun/Run/Val/Prim.chs" #-} -- | Voidify IO on RVal level, i.e. make IO () -- rvalVoid :: (RunSem RValCxt RValEnv RVal m RVal) => RValT m a -> RValT m RVal rvalVoid :: (RunSem RValCxt RValEnv RVal m a) => RValT m b -> RValT m a@@ -313,7 +328,7 @@ liftIO (io x' y') >>= hsUnmarshall -- {-# INLINE primIO_2Arg0Res #-} -{-# LINE 347 "src/ehc/CoreRun/Run/Val/Prim.chs" #-}+{-# LINE 362 "src/ehc/CoreRun/Run/Val/Prim.chs" #-} deriving instance Generic IOMode instance HSMarshall IOMode
@@ -1,5 +1,6 @@ -- {-# LANGUAGE MagicHash #-} -- {-# OPTIONS_GHC -O2 #-}+-- {-# OPTIONS_GHC -O3 #-} module UHC.Light.Compiler.CoreRun.Run.Val.RunExplStk ( cmodRun )@@ -19,9 +20,10 @@ import UHC.Util.Pretty import qualified Data.Vector as V import qualified Data.Vector.Mutable as MV+import Data.List import qualified Data.ByteString.Char8 as BSC8 -{-# LINE 38 "src/ehc/CoreRun/Run/Val/RunExplStk.chs" #-}+{-# LINE 42 "src/ehc/CoreRun/Run/Val/RunExplStk.chs" #-} -- | Arguments to a function, which may come from an RVal_App or from the stack data ExplArgs = ExplArgs { eaVec :: !RValV -- ^ the accumulated part from RVal_App@@ -48,17 +50,22 @@ eaLen = eaNrArgs ea {-# INLINE renvFrStkEaPopMV #-} -{-# LINE 66 "src/ehc/CoreRun/Run/Val/RunExplStk.chs" #-}+{-# LINE 70 "src/ehc/CoreRun/Run/Val/RunExplStk.chs" #-} -- | Allocate a new frame-explStkAllocFrameM :: (RunSem RValCxt RValEnv RVal m x) => Ref2Nm -> HpPtr -> {- Int -> -} Int -> ExplArgs -> RValT m HpPtr-explStkAllocFrameM r2n sl {- lev -} sz as@(ExplArgs {eaVec=vsArgs, eaStk=nrArgs}) = do+explStkAllocFrameM+ :: (RunSem RValCxt RValEnv RVal m x)+ => Ref2Nm -- ^ ref <-> name mapping+ -> RCxt -- ^ context+ -> Int -- ^ size+ -> ExplArgs -- ^ arguments+ -> RValT m HpPtr+explStkAllocFrameM r2n cx sz as@(ExplArgs {eaVec=vsArgs, eaStk=nrArgs}) = do a <- liftIO $ mvecAllocInit sz -- (sz+3) -- TBD: stack overflow somewhere... let vsLen = V.length vsArgs when (vsLen > 0) $ liftIO $ mvecFillFromV 0 a vsArgs when (nrArgs > 0) $ renvFrStkReversePopInMV vsLen nrArgs a- slref <- liftIO $ newIORef sl spref <- liftIO $ newIORef (eaNrArgs as)- p <- heapAllocM $ RVal_Frame r2n slref {- lev -} a spref+ p <- heapAllocM $ RVal_Frame r2n cx a spref return p -- | Push a new stack frame@@ -72,17 +79,29 @@ {-# INLINE explStkPushFrameM #-} -- | Allocate and push a new stack frame-explStkPushAllocFrameM :: (RunSem RValCxt RValEnv RVal m x) => Ref2Nm -> HpPtr -> {- Int -> -} Int -> ExplArgs -> RValT m HpPtr-explStkPushAllocFrameM r2n sl {- lev -} sz as = do- p <- explStkAllocFrameM r2n sl {- lev -} sz as+explStkPushAllocFrameM+ :: (RunSem RValCxt RValEnv RVal m x)+ => Ref2Nm -- ^ ref <-> name mapping+ -> RCxt -- ^ context+ -> Int -- ^ size+ -> ExplArgs -- ^ arguments+ -> RValT m HpPtr+explStkPushAllocFrameM r2n cx sz as = do+ p <- explStkAllocFrameM r2n cx sz as explStkPushFrameM p return p {-# INLINE explStkPushAllocFrameM #-} -- | Allocate and replace top stack frame-explStkReplaceAllocFrameM :: (RunSem RValCxt RValEnv RVal m x) => Ref2Nm -> HpPtr -> {- Int -> -} Int -> ExplArgs -> RValT m ()-explStkReplaceAllocFrameM r2n sl {- lev -} sz as = do- p <- explStkAllocFrameM r2n sl {- lev -} sz as+explStkReplaceAllocFrameM+ :: (RunSem RValCxt RValEnv RVal m x)+ => Ref2Nm -- ^ ref <-> name mapping+ -> RCxt -- ^ context+ -> Int -- ^ size+ -> ExplArgs -- ^ arguments+ -> RValT m ()+explStkReplaceAllocFrameM r2n cx sz as = do+ p <- explStkAllocFrameM r2n cx sz as (RValEnv {renvTopFrame=tf}) <- get liftIO $ writeIORef tf p {-# INLINE explStkReplaceAllocFrameM #-}@@ -102,18 +121,19 @@ return tf {-# INLINE explStkPopFrameM #-} -{-# LINE 125 "src/ehc/CoreRun/Run/Val/RunExplStk.chs" #-}+{-# LINE 146 "src/ehc/CoreRun/Run/Val/RunExplStk.chs" #-} cmodRun :: (RunSem RValCxt RValEnv RVal m ()) => EHCOpts -> Mod -> RValT m ()-cmodRun opts (Mod_Mod {body_Mod_Mod=e}) = do+cmodRun opts (Mod_Mod {mbbody_Mod_Mod = Just e}) = do -- dumpEnvM True mustReturn $ rsemExp e -- v <- renvFrStkPop1 -- return v+cmodRun opts _ = return () -{-# LINE 142 "src/ehc/CoreRun/Run/Val/RunExplStk.chs" #-}+{-# LINE 164 "src/ehc/CoreRun/Run/Val/RunExplStk.chs" #-} -- | Apply Lam in context of static link with exact right amount of params, otherwise the continuation is used-rvalExplStkAppLam :: RunSem RValCxt RValEnv RVal m () => HpPtr -> Exp -> ExplArgs -> (Int -> RValT m ()) -> RValT m ()-rvalExplStkAppLam sl f as failcont = do+rvalExplStkAppLam :: RunSem RValCxt RValEnv RVal m () => RCxt -> Exp -> ExplArgs -> (Int -> RValT m ()) -> RValT m ()+rvalExplStkAppLam cx f as failcont = do let nrActualArgs = eaNrArgs as case f of Exp_Lam {{- lev_Exp_Lam=l, -} mbNm_Exp_Lam=mn, nrArgs_Exp_Lam=nrRequiredArgs, stkDepth_Exp_Lam=sz, ref2nm_Exp_Lam=r2n, body_Exp_Lam=b}@@ -123,13 +143,13 @@ rvalTrEnterLam mn $ if needRet then do- explStkPushAllocFrameM r2n sl {- l -} sz as+ explStkPushAllocFrameM r2n cx sz as rsemExp b v <- renvFrStkPop1 explStkPopFrameM renvFrStkPush1 v else do- explStkReplaceAllocFrameM r2n sl {- l -} sz as+ explStkReplaceAllocFrameM r2n cx sz as mustReturn $ rsemExp b -- rsemTr $ "<V (" ++ show mn ++ ")" | otherwise -> failcont nrRequiredArgs@@ -137,16 +157,16 @@ -- {-# SPECIALIZE rvalExplStkAppLam :: HpPtr -> Exp -> RValMV -> (Int -> RValT IO RVal) -> RValT IO RVal #-} -- {-# INLINE rvalExplStkAppLam #-} -{-# LINE 170 "src/ehc/CoreRun/Run/Val/RunExplStk.chs" #-}+{-# LINE 192 "src/ehc/CoreRun/Run/Val/RunExplStk.chs" #-} -- | Apply. Assume: function 'f' is already evaluated (responsibility lies outside) rvalExplStkApp :: RunSem RValCxt RValEnv RVal m () => RVal -> ExplArgs -> RValT m () rvalExplStkApp f as = do -- rsemTr $ "V app f(" ++ show (MV.length as) ++ "): " ++ show (pp f) let nrActualArgs = eaNrArgs as case f of- RVal_Lam {rvalSLRef=slref, rvalBody=b} -> do- sl <- liftIO $ readIORef slref- rvalExplStkAppLam sl b as $ \narg -> do+ RVal_Lam {rvalCx=rcx, rvalBody=b} -> do+ -- sl <- liftIO $ readIORef (rcxtSlRef rcx)+ rvalExplStkAppLam rcx b as $ \narg -> do if nrActualArgs < narg then do renvFrStkEaPopMV as >>= \as -> heapAllocAsPtrM (RVal_App f as) >>= renvFrStkPush1@@ -161,7 +181,7 @@ -- {-# SPECIALIZE rvalExplStkApp :: RunSem RValCxt RValEnv RVal IO RVal => RVal -> RValMV -> RValT IO RVal #-} -- {-# INLINE rvalExplStkApp #-} -{-# LINE 195 "src/ehc/CoreRun/Run/Val/RunExplStk.chs" #-}+{-# LINE 217 "src/ehc/CoreRun/Run/Val/RunExplStk.chs" #-} -- | rsemExp for RVal, without explicit use of expr stack, i.e. implicit stack via Haskell thereby preventing correct GC rvalExplStkExp :: RunSem RValCxt RValEnv RVal m () => Exp -> RValT m () {-# SPECIALIZE rvalExplStkExp :: RunSem RValCxt RValEnv RVal IO () => Exp -> RValT IO () #-}@@ -186,9 +206,9 @@ | na == 0 -> mk heapAllocAsPtrM RVal_Thunk | otherwise -> mk return RVal_Lam where mk alloc rv = do- sl <- renvTopFrameM- slref <- liftIO $ newIORef sl- alloc (rv mn e slref) >>= rsemPush+ (sl,fr) <- renvTopFramePtrAndFrameM+ cx <- liftIO $ rcxtCloneWithNewFrame sl (rvalCx fr)+ alloc (rv mn e cx) >>= rsemPush -- let Exp_Let {firstOff_Exp_Let=fillFrom, ref2nm_Exp_Let=r2n, binds_Exp_Let=bs, body_Exp_Let=b} -> do@@ -227,7 +247,38 @@ rsemTr $ "<E:" >#< (e) -- >-< e') -- return e' -{-# LINE 272 "src/ehc/CoreRun/Run/Val/RunExplStk.chs" #-}+{-# LINE 294 "src/ehc/CoreRun/Run/Val/RunExplStk.chs" #-}+-- | Add module+rvalExplAddModule :: RunSem RValCxt RValEnv RVal m () => Mod -> RValT m HpPtr+rvalExplAddModule mod@(Mod_Mod {moduleNm_Mod_Mod=nm, ref2nm_Mod_Mod=r2n, binds_Mod_Mod=bs, stkDepth_Mod_Mod=sz, imports_Mod_Mod=imports}) = do+ -- add new entry+ env@(RValEnv {renvModulesMV=mods}) <- get+ mods' <- liftIO $ MV.grow mods 1+ put $ env {renvModulesMV = mods'}+ --+ env@(RValEnv {renvModulesMV=mods, renvGlobalsMV=globs}) <- get+ let nr = MV.length mods - 1+ -- get import indirection table+ imptbl <- renvResolveModNames [ nm | Import_Import {nm_Import_Import=nm} <- imports ]+ -- construct context (module is patched in later)+ cx <- liftIO $ mkRCxt nullPtr nullPtr+ -- construct frame+ f <- explStkPushAllocFrameM r2n cx sz emptyExplArgs+ -- construct module, set the module entry+ fr <- liftIO $ newIORef f+ m <- heapAllocM $ RVal_Module nm (crarrayFromList imptbl) fr+ liftIO $ do+ -- fill global module entry+ MV.write mods nr m+ -- patch module ref in context+ writeIORef (rcxtMdRef cx) m+ -- compute module bindings into current frame+ V.forM_ bs rsemExp+ -- remove the frame+ explStkPopFrameM+ where++{-# LINE 326 "src/ehc/CoreRun/Run/Val/RunExplStk.chs" #-} instance ( Monad m, MonadIO m, Functor m ) => RunSem RValCxt RValEnv RVal m ()@@ -238,14 +289,24 @@ return (emptyRValCxt, s, undefined) rsemSetup opts modImpL mod@(Mod_Mod {moduleNr_Mod_Mod=mainModNr}) = do+{-+-}+ let modAllL = modImpL ++ [mod]+ modFrames <- forM modAllL $ \mod -> do+ rvalExplAddModule mod+ explStkPushFrameM (last modFrames)+ rcxtUpdDatatypes modAllL+{- -- rsemSetTrace True rsemGcEnterRootLevel let modAllL = modImpL ++ [mod] ms <- liftIO $ MV.new (maximum (map moduleNr_Mod_Mod modAllL) + 1) modify $ \env -> env {renvGlobalsMV = ms} forM_ modAllL $ \(Mod_Mod {ref2nm_Mod_Mod=r2n, moduleNr_Mod_Mod=nr, binds_Mod_Mod=bs, stkDepth_Mod_Mod=sz}) -> do+ -- context (ignoring module stuff, TBD)+ cx <- liftIO $ mkRCxtSl nullPtr -- construct frame for each module- p <- explStkPushAllocFrameM r2n nullPtr sz emptyExplArgs+ p <- explStkPushAllocFrameM r2n cx sz emptyExplArgs -- and store the frame into the array holding module frames (liftIO $ MV.write ms nr p >> newIORef p) >>= \r -> rsemGcPushRoot (RVal_Ptr r) -- holding all local defs@@ -257,6 +318,7 @@ rsemGcLeaveRootLevel rsemSetupTracing opts rcxtUpdDatatypes modAllL+-} rsemSetTrace doTrace doExtensive = modify $ \env -> env {renvDoTrace = doTrace, renvDoTraceExt = doExtensive}@@ -289,11 +351,11 @@ hp <- gets renvHeap v <- heapGetM' hp p case v of- RVal_Thunk {rvalMbNm=mn, rvalSLRef=slref, rvalBody=e} -> do+ RVal_Thunk {rvalMbNm=mn, rvalCx=rcx, rvalBody=e} -> do -- rsemGcPushRoot v- sl <- liftIO $ readIORef slref+ -- sl <- liftIO $ readIORef (rcxtSlRef rcx) heapSetM' hp p RVal_BlackHole- v' <- rvalExplStkAppLam sl e (emptyExplArgs {eaStk=0}) $ \_ -> err $ "CoreRun.Run.Val.rsemEvl.RVal_Thunk:" >#< e+ v' <- rvalExplStkAppLam rcx e (emptyExplArgs {eaStk=0}) $ \_ -> err $ "CoreRun.Run.Val.rsemEvl.RVal_Thunk:" >#< e hp <- gets renvHeap p <- liftIO (readIORef pref) v'' <- rsemPop v'
@@ -33,9 +33,9 @@ implStkAllocFrameM :: (RunSem RValCxt RValEnv RVal m RVal) => Ref2Nm -> HpPtr -> {- Int -> -} Int -> RValMV -> RValT m HpPtr implStkAllocFrameM r2n sl {- lev -} sz as = do a <- liftIO $ mvecAllocInit sz- slref <- liftIO $ newIORef sl+ cx <- liftIO $ mkRCxtSl sl spref <- liftIO $ newIORef sz -- (MV.length as) -- stack is not used, GC looks up until this location- let fr = RVal_Frame r2n slref {- lev -} a spref+ let fr = RVal_Frame r2n cx a spref fillFrameM 0 as fr heapAllocM fr @@ -73,12 +73,13 @@ {-# LINE 94 "src/ehc/CoreRun/Run/Val/RunImplStk.chs" #-} cmodRun :: (RunSem RValCxt RValEnv RVal m RVal) => EHCOpts -> Mod -> RValT m RVal-cmodRun opts (Mod_Mod {body_Mod_Mod=e}) = do+cmodRun opts (Mod_Mod {mbbody_Mod_Mod = Just e}) = do -- dumpEnvM True v <- mustReturn $ rsemExp e return v+cmodRun opts _ = err $ "Cannot run module without main" -{-# LINE 110 "src/ehc/CoreRun/Run/Val/RunImplStk.chs" #-}+{-# LINE 111 "src/ehc/CoreRun/Run/Val/RunImplStk.chs" #-} -- | Apply Lam in context of static link with exact right amount of params, otherwise the continuation is used rvalImplStkAppLam :: RunSem RValCxt RValEnv RVal m RVal => HpPtr -> Exp -> RValMV -> (Int -> RValT m RVal) -> RValT m RVal rvalImplStkAppLam sl f as failcont = do@@ -106,8 +107,8 @@ rvalImplStkApp f as = do -- rsemTr $ "V app f(" ++ show (MV.length as) ++ "): " ++ show (pp f) case f of- RVal_Lam {rvalSLRef=slref, rvalBody=b} -> do- sl <- liftIO $ readIORef slref+ RVal_Lam {rvalCx=rcx, rvalBody=b} -> do+ sl <- liftIO $ readIORef (rcxtSlRef rcx) rvalImplStkAppLam sl b as $ \narg -> do if MV.length as < narg then do@@ -125,7 +126,7 @@ -- {-# SPECIALIZE rvalImplStkApp :: RunSem RValCxt RValEnv RVal IO RVal => RVal -> RValMV -> RValT IO RVal #-} -- {-# INLINE rvalImplStkApp #-} -{-# LINE 158 "src/ehc/CoreRun/Run/Val/RunImplStk.chs" #-}+{-# LINE 159 "src/ehc/CoreRun/Run/Val/RunImplStk.chs" #-} -- | rsemExp for RVal, without explicit use of expr stack, i.e. implicit stack via Haskell thereby preventing correct GC rvalImplStkExp :: RunSem RValCxt RValEnv RVal m RVal => Exp -> RValT m RVal -- {-# SPECIALIZE rvalImplStkExp :: RunSem RValCxt RValEnv RVal IO RVal => Exp -> RValT IO RVal #-}@@ -147,14 +148,14 @@ | na == 0 -> mk (RVal_Thunk mn) >>= heapAllocM >>= (liftIO . newIORef) >>= (return . RVal_Ptr) | otherwise -> mk (RVal_Lam mn) where mk rv = do- sl <- renvTopFrameM- slref <- liftIO $ newIORef sl- return $ rv e slref+ (sl,fr) <- renvTopFramePtrAndFrameM+ cx <- liftIO $ rcxtCloneWithNewFrame sl (rvalCx fr)+ return $ rv e cx -- let Exp_Let {firstOff_Exp_Let=fillFrom, ref2nm_Exp_Let=r2n, binds_Exp_Let=bs, body_Exp_Let=b} -> do bs' <- mustReturn $ (liftIO . V.thaw) =<< V.forM bs rsemExp- fr <- renvTopFrameM >>= heapGetM -- >>= rsemDeref+ fr <- renvTopFrameM -- >>= heapGetM -- >>= rsemDeref fillFrameM fillFrom bs' fr rsemExp b @@ -186,7 +187,7 @@ -{-# LINE 230 "src/ehc/CoreRun/Run/Val/RunImplStk.chs" #-}+{-# LINE 231 "src/ehc/CoreRun/Run/Val/RunImplStk.chs" #-} instance ( Monad m, MonadIO m, Functor m ) => RunSem RValCxt RValEnv RVal m RVal@@ -235,8 +236,8 @@ v <- heapGetM' hp p -- rsemTr $ "Evl: *" >|< p >|< ":" >#< v v' <- case v of- RVal_Thunk {rvalSLRef=slref, rvalBody=e} -> do- sl <- liftIO $ readIORef slref+ RVal_Thunk {rvalCx=rcx, rvalBody=e} -> do+ sl <- liftIO $ readIORef (rcxtSlRef rcx) heapSetM' hp p RVal_BlackHole v' <- liftIO (mvecAlloc 0) >>= \v -> rvalImplStkAppLam sl e v $ \_ -> err $ "CoreRun.Run.Val.rsemEvl.RVal_Thunk:" >#< e heapSetM' hp p v'
@@ -0,0 +1,48 @@+{-# LANGUAGE GADTs #-}++module UHC.Light.Compiler.EHC.BuildFunction+( BFun (..) )+where+import UHC.Light.Compiler.EHC.Common+import UHC.Light.Compiler.EHC.CompileUnit+import Control.Applicative++{-# LINE 29 "src/ehc/EHC/BuildFunction.chs" #-}+-- | Representation of build functions (embedded comment screws up haddock, hence see source code directly)+data BFun res where+ --- | Obtain FPath of an (imported module)+ FPathOfImported+ :: HsName --- ^ module name+ -> BFun FPath++ --- | Extract imported modules from a module+ ImportsOf+ :: HsName --- ^ module name+ -> BFun [HsName]++ --- | Extract compileunit from a module+ EcuOf+ :: HsName --- ^ module name+ -> BFun EHCompileUnit++ --- | Applicative: pure+ Pure+ :: res+ -> BFun res++ --- | Applicative: <*>+ App+ :: BFun (res1 -> res2)+ -> BFun res1+ -> BFun res2++instance Functor BFun where+ fmap f (Pure x) = Pure (f x)+ fmap f (App g x) = App (fmap (f .) g) x+ fmap _ _ = panic "BuildFuncion.Functor.BFun"++instance Applicative BFun where+ pure = Pure+ (<*>) = App++
@@ -0,0 +1,25 @@+{-# LANGUAGE GADTs #-}++module UHC.Light.Compiler.EHC.BuildFunction.Run+( runBFun )+where+import UHC.Light.Compiler.EHC.BuildFunction+import UHC.Light.Compiler.EHC.CompileRun+import UHC.Light.Compiler.EHC.CompileUnit++{-# LINE 29 "src/ehc/EHC/BuildFunction/Run.chs" #-}+runBFun :: EHCCompileRunner m => BFun res -> EHCompilePhaseT m res+runBFun bfun = do+ case bfun of+ -- Applicative part+ Pure res -> return res+ App f a -> do+ f' <- runBFun f+ a' <- runBFun a+ return $ f' a'++ -- The actual work+ EcuOf modNm -> do+ return undefined+ _ -> return undefined+
@@ -1,16 +1,18 @@ module UHC.Light.Compiler.EHC.Common ( module Data.Maybe, module Data.List, module Data.Char , module System.IO-, module UHC.Util.CompileRun, module UHC.Util.Pretty, module UHC.Util.FPath, module UHC.Util.Utils+, module UHC.Util.CompileRun2, module UHC.Util.Pretty, module UHC.Util.FPath, module UHC.Util.Utils , module UHC.Light.Compiler.Base.Common, module UHC.Light.Compiler.Base.HsName.Builtin, module UHC.Light.Compiler.Opts , module UHC.Light.Compiler.Error, module UHC.Light.Compiler.Error.Pretty , module UHC.Light.Compiler.Gam.Full , HSState (..) , EHState (..) , CRState (..)+, CRRState (..) , EHCompileUnitState (..) , ecuStateFinalDestination , ecuStateIsCore+, ecuStateIsCoreRun , EHCompileUnitKind (..) , ecuStateToKind , FinalCompileHow (..)@@ -30,7 +32,7 @@ import Data.Maybe import Control.Monad.State import System.IO-import UHC.Util.CompileRun+import UHC.Util.CompileRun2 import UHC.Util.Pretty import UHC.Util.FPath import UHC.Util.Utils@@ -105,13 +107,21 @@ {-# LINE 124 "src/ehc/EHC/Common.chs" #-} data CRState- = CRStartText- | CRStartBinary+ = CRStartBinary+ | CRStartText | CROnlyImports | CRAllSem deriving (Show,Eq) -{-# LINE 135 "src/ehc/EHC/Common.chs" #-}+{-# LINE 133 "src/ehc/EHC/Common.chs" #-}+data CRRState+ = CRRStartBinary+ -- | CRRStartText+ | CRROnlyImports+ | CRRAllSem+ deriving (Show,Eq)++{-# LINE 144 "src/ehc/EHC/Common.chs" #-} data EHCompileUnitState = ECUS_Unknown | ECUS_Haskell !HSState@@ -119,11 +129,12 @@ | ECUS_C !CState | ECUS_O !OState | ECUS_Core !CRState+ | ECUS_CoreRun !CRRState | ECUS_Grin | ECUS_Fail deriving (Show,Eq) -{-# LINE 152 "src/ehc/EHC/Common.chs" #-}+{-# LINE 164 "src/ehc/EHC/Common.chs" #-} -- | The final state ecuStateFinalDestination :: (EHCompileUnitState -> EHCompileUnitState) -> EHCompileUnitState -> EHCompileUnitState ecuStateFinalDestination postModf@@ -133,23 +144,31 @@ n (ECUS_C _) = ECUS_C CAllSem n (ECUS_O _) = ECUS_O OAllSem n (ECUS_Core _) = ECUS_Core CRAllSem+ n (ECUS_CoreRun _) = ECUS_CoreRun CRRAllSem n _ = ECUS_Fail -{-# LINE 169 "src/ehc/EHC/Common.chs" #-}+{-# LINE 184 "src/ehc/EHC/Common.chs" #-} -- | Is compilation from Core source ecuStateIsCore :: EHCompileUnitState -> Bool ecuStateIsCore st = case st of ECUS_Core _ -> True _ -> False -{-# LINE 183 "src/ehc/EHC/Common.chs" #-}+{-# LINE 194 "src/ehc/EHC/Common.chs" #-}+-- | Is compilation from CoreRun source+ecuStateIsCoreRun :: EHCompileUnitState -> Bool+ecuStateIsCoreRun st = case st of+ ECUS_CoreRun _ -> True+ _ -> False++{-# LINE 208 "src/ehc/EHC/Common.chs" #-} data EHCompileUnitKind = EHCUKind_HS -- Haskell: .hs .lhs .hi | EHCUKind_C -- C: .c | EHCUKind_None -- Nothing deriving Eq -{-# LINE 193 "src/ehc/EHC/Common.chs" #-}+{-# LINE 218 "src/ehc/EHC/Common.chs" #-} ecuStateToKind :: EHCompileUnitState -> EHCompileUnitKind ecuStateToKind s = case s of@@ -157,12 +176,12 @@ ECUS_C _ -> EHCUKind_C _ -> EHCUKind_None -{-# LINE 208 "src/ehc/EHC/Common.chs" #-}+{-# LINE 233 "src/ehc/EHC/Common.chs" #-} data FinalCompileHow = FinalCompile_Module | FinalCompile_Exec -{-# LINE 218 "src/ehc/EHC/Common.chs" #-}+{-# LINE 243 "src/ehc/EHC/Common.chs" #-} mkShellCmd' :: [Cmd] -> FilePath -> CmdLineOpts -> (FilePath,[String]) mkShellCmd' forCmds cmdStr o = (cmdStr, showCmdLineOpts' forCmds o) @@ -172,7 +191,7 @@ showShellCmd :: (FilePath,[String]) -> String showShellCmd (cmd,args) = concat $ intersperse " " $ [cmd] ++ args -{-# LINE 233 "src/ehc/EHC/Common.chs" #-}+{-# LINE 258 "src/ehc/EHC/Common.chs" #-} mkInOrOutputFPathDirFor :: FPATH nm => InOrOutputFor -> EHCOpts -> nm -> FPath -> String -> (FPath,Maybe String) mkInOrOutputFPathDirFor inoutputfor opts modNm fp suffix = (fpathSetSuff suffix fp', d)@@ -191,16 +210,16 @@ where d' = filePathUnPrefix d _ -> (fp,Nothing) -{-# LINE 258 "src/ehc/EHC/Common.chs" #-}+{-# LINE 283 "src/ehc/EHC/Common.chs" #-} mkInOrOutputFPathFor :: FPATH nm => InOrOutputFor -> EHCOpts -> nm -> FPath -> String -> FPath mkInOrOutputFPathFor inoutputfor opts modNm fp suffix = fst $ mkInOrOutputFPathDirFor inoutputfor opts modNm fp suffix -{-# LINE 264 "src/ehc/EHC/Common.chs" #-}+{-# LINE 289 "src/ehc/EHC/Common.chs" #-} mkOutputFPath :: FPATH nm => EHCOpts -> nm -> FPath -> String -> FPath mkOutputFPath = mkInOrOutputFPathFor OutputFor_Module -{-# LINE 273 "src/ehc/EHC/Common.chs" #-}+{-# LINE 298 "src/ehc/EHC/Common.chs" #-} -- | FPath for per module output mkPerModuleOutputFPath :: EHCOpts -> Bool -> HsName -> FPath -> String -> FPath mkPerModuleOutputFPath opts doSepBy_ modNm fp suffix@@ -212,7 +231,7 @@ where nm_ = mkOutputFPath opts (hsnMapQualified (const base) m) (fpathSetBase base f) suffix where base = hsnShow "_" "_" m -{-# LINE 290 "src/ehc/EHC/Common.chs" #-}+{-# LINE 315 "src/ehc/EHC/Common.chs" #-} -- | FPath for final executable, with possible suffix (and forcing flag, even on given exec) mkPerExecOutputFPath :: EHCOpts -> HsName -> FPath -> Maybe (String, Bool) -> FPath mkPerExecOutputFPath opts modNm fp mbSuffix
@@ -10,14 +10,14 @@ import Control.Monad.State {-# LINE 33 "src/ehc/EHC/CompilePhase/Cleanup.chs" #-}-cpCleanupHSMod :: HsName -> EHCompilePhase ()+cpCleanupHSMod :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpCleanupHSMod modNm = cpUpdCU modNm (\e -> e { ecuMbHSSemMod = Nothing } ) -cpCleanupHS :: HsName -> EHCompilePhase ()+cpCleanupHS :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpCleanupHS modNm = cpUpdCU modNm (\e -> e { ecuMbHS = Nothing@@ -25,14 +25,14 @@ } ) -cpCleanupFoldEH :: HsName -> EHCompilePhase ()+cpCleanupFoldEH :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpCleanupFoldEH modNm = cpUpdCU modNm (\e -> e { ecuMbEH = Nothing } ) -cpCleanupEH :: HsName -> EHCompilePhase ()+cpCleanupEH :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpCleanupEH modNm = cpUpdCU modNm (\e -> e { ecuMbEHSem = Nothing@@ -40,7 +40,7 @@ ) {-# LINE 64 "src/ehc/EHC/CompilePhase/Cleanup.chs" #-}-cpCleanupCore :: [HsName] -> EHCompilePhase ()+cpCleanupCore :: EHCCompileRunner m => [HsName] -> EHCompilePhaseT m () cpCleanupCore modNmL = cpSeq [cl m | m <- modNmL] where cl m = cpUpdCU m@@ -51,7 +51,7 @@ ) {-# LINE 116 "src/ehc/EHC/CompilePhase/Cleanup.chs" #-}-cpCleanupCU :: HsName -> EHCompilePhase ()+cpCleanupCU :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpCleanupCU modNm = do { cpUpdCU modNm (\e -> e { ecuHIInfo = {- HI.hiiRetainAfterCleanup -} (ecuHIInfo e)@@ -60,7 +60,7 @@ ) } -cpCleanupFlow :: HsName -> EHCompilePhase ()+cpCleanupFlow :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpCleanupFlow modNm = cpUpdCU modNm (\e -> e { ecuMbHSSemMod = Nothing
@@ -16,7 +16,7 @@ {-# LINE 43 "src/ehc/EHC/CompilePhase/Common.chs" #-} -- | Compute impl info for module codegen-cpGenModuleImportExportImpl :: HsName -> EHCompilePhase ModuleImportExportImpl+cpGenModuleImportExportImpl :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ModuleImportExportImpl cpGenModuleImportExportImpl modNm = do { cr <- get ; cpMsg modNm VerboseDebug "cpGenModuleImportExportImpl"@@ -27,11 +27,11 @@ | otherwise = crsiExpNmOffMp modNm crsi modOffMp | isWholeProg = Map.filterWithKey (\n _ -> n == modNm) $ crsiModOffMp crsi | otherwise = crsiModOffMp crsi- -- ; lift $ putStrLn $ "cpGenModuleImportExportImpl " ++ show impNmL- -- ; lift $ putStrLn $ "cpGenModuleImportExportImpl ecuHSDeclImpNmS " ++ show (ecuHSDeclImpNmS ecu)- -- ; lift $ putStrLn $ "cpGenModuleImportExportImpl ecuHIDeclImpNmS " ++ show (ecuHIDeclImpNmS ecu)- -- ; lift $ putStrLn $ "cpGenModuleImportExportImpl ecuHIUsedImpNmS " ++ show (ecuHIUsedImpNmS ecu)- -- ; lift $ putStrLn $ "cpGenModuleImportExportImpl modOffMp " ++ show modOffMp+ -- ; liftIO $ putStrLn $ "cpGenModuleImportExportImpl " ++ show impNmL+ -- ; liftIO $ putStrLn $ "cpGenModuleImportExportImpl ecuHSDeclImpNmS " ++ show (ecuHSDeclImpNmS ecu)+ -- ; liftIO $ putStrLn $ "cpGenModuleImportExportImpl ecuHIDeclImpNmS " ++ show (ecuHIDeclImpNmS ecu)+ -- ; liftIO $ putStrLn $ "cpGenModuleImportExportImpl ecuHIUsedImpNmS " ++ show (ecuHIUsedImpNmS ecu)+ -- ; liftIO $ putStrLn $ "cpGenModuleImportExportImpl modOffMp " ++ show modOffMp -- ecuHSDeclImpNmS ecu, ecuHIDeclImpNmS ecu, ecuHIUsedImpNmS ecu ; return $ emptyModuleImportExportImpl { mieimplLamMp = Core2GrSem.lamMp_Inh_CodeAGItf $ crsiCoreInh crsi
@@ -37,7 +37,7 @@ where (ds,pdmp) = pkgPartInclDirs opts pkgKeyDirL {-# LINE 77 "src/ehc/EHC/CompilePhase/CompileC.chs" #-}-cpCompileWithGCC :: FinalCompileHow -> [HsName] -> HsName -> EHCompilePhase ()+cpCompileWithGCC :: EHCCompileRunner m => FinalCompileHow -> [HsName] -> HsName -> EHCompilePhaseT m () cpCompileWithGCC how othModNmL modNm = do { cr <- get ; let (ecu,crsi,opts,fp) = crBaseInfo modNm cr@@ -110,12 +110,12 @@ ) ; when (ehcOptVerbosity opts >= VerboseALot) (do { cpMsg' modNm VerboseALot "GCC" Nothing fpTarg- ; lift $ putStrLn $ showShellCmd compileC+ ; liftIO $ putStrLn $ showShellCmd compileC }) ; when (ehcOptVerbosity opts >= VerboseDebug)- (do { lift $ putStrLn ("pkgs : " ++ show pkgKeyL)- ; lift $ putStrLn ("pkgdirs : " ++ show pkgKeyDirL)- ; lift $ putStrLn ("other: " ++ show othModNmL2)+ (do { liftIO $ putStrLn ("pkgs : " ++ show pkgKeyL)+ ; liftIO $ putStrLn ("pkgdirs : " ++ show pkgKeyDirL)+ ; liftIO $ putStrLn ("other: " ++ show othModNmL2) }) ; cpSeq [ cpSystem' Nothing compileC , cpUpdCU modNm (ecuStoreGenCodeFiles genOFiles)@@ -124,7 +124,7 @@ } {-# LINE 196 "src/ehc/EHC/CompilePhase/CompileC.chs" #-}-cpPreprocessWithCPP :: [PkgModulePartition] -> HsName -> EHCompilePhase ()+cpPreprocessWithCPP :: EHCCompileRunner m => [PkgModulePartition] -> HsName -> EHCompilePhaseT m () cpPreprocessWithCPP pkgKeyDirL modNm = do { cr <- get ; let (ecu,crsi,opts,fp) = crBaseInfo modNm cr@@ -143,14 +143,14 @@ ) ; when (ehcOptVerbosity opts >= VerboseALot) (do { cpMsg modNm VerboseALot "CPP"- -- ; lift $ putStrLn ("pkg db: " ++ show (ehcOptPkgDb opts))- -- ; lift $ putStrLn ("pkg srch filter: " ++ (show $ ehcOptPackageSearchFilter opts))- -- ; lift $ putStrLn ("exposed pkgs: " ++ show (pkgExposedPackages $ ehcOptPkgDb opts))- -- ; lift $ putStrLn ("pkgKeyDirL: " ++ show pkgKeyDirL)- ; lift $ putStrLn $ showShellCmd preCPP+ -- ; liftIO $ putStrLn ("pkg db: " ++ show (ehcOptPkgDb opts))+ -- ; liftIO $ putStrLn ("pkg srch filter: " ++ (show $ ehcOptPackageSearchFilter opts))+ -- ; liftIO $ putStrLn ("exposed pkgs: " ++ show (pkgExposedPackages $ ehcOptPkgDb opts))+ -- ; liftIO $ putStrLn ("pkgKeyDirL: " ++ show pkgKeyDirL)+ ; liftIO $ putStrLn $ showShellCmd preCPP }) ; when (crModCanCompile modNm cr)- (do { lift $ fpathEnsureExists fpCPP+ (do { liftIO $ fpathEnsureExists fpCPP ; cpSystem' (Just $ fpathToStr fpCPP) preCPP ; cpRegisterFilesToRm [fpCPP] })
@@ -49,7 +49,7 @@ gamUnionFlow = gamUnion {-# LINE 96 "src/ehc/EHC/CompilePhase/FlowBetweenPhase.chs" #-}-cpFlowHsSem1 :: HsName -> EHCompilePhase ()+cpFlowHsSem1 :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpFlowHsSem1 modNm = do { cr <- get ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr@@ -80,14 +80,14 @@ ; when (isJust (ecuMbHSSem ecu)) (do { cpUpdSI (\crsi -> crsi {crsiHSInh = hsInh', crsiEHInh = ehInh', crsiOpts = opts'}) ; cpUpdCU modNm $! ecuStoreHIInfo hii'- -- ; lift $ putStrLn (forceEval hii' `seq` "cpFlowHsSem1")+ -- ; liftIO $ putStrLn (forceEval hii' `seq` "cpFlowHsSem1") })- -- ; lift $ putWidthPPLn 120 (ppGam $ EHSem.idQualGam_Inh_AGItf $ ehInh')+ -- ; liftIO $ putWidthPPLn 120 (ppGam $ EHSem.idQualGam_Inh_AGItf $ ehInh') } {-# LINE 139 "src/ehc/EHC/CompilePhase/FlowBetweenPhase.chs" #-}-cpFlowEHSem1 :: HsName -> EHCompilePhase ()+cpFlowEHSem1 :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpFlowEHSem1 modNm = do { cr <- get ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr@@ -153,7 +153,7 @@ } {-# LINE 243 "src/ehc/EHC/CompilePhase/FlowBetweenPhase.chs" #-}-cpFlowHISem :: HsName -> EHCompilePhase ()+cpFlowHISem :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpFlowHISem modNm = do { cr <- get ; let (ecu,crsi,_,_) = crBaseInfo modNm cr@@ -192,29 +192,23 @@ {-# LINE 294 "src/ehc/EHC/CompilePhase/FlowBetweenPhase.chs" #-} -- | Flow info after Core source check-cpFlowCoreModSem :: HsName -> EHCompilePhase ()+cpFlowCoreModSem :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpFlowCoreModSem modNm = do { cr <- get ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr- -- ehInh = crsiEHInh crsi coreInh = crsiCoreInh crsi mbCoreModSem = ecuMbCoreSemMod ecu ; when (isJust mbCoreModSem) $ do { let coreModSem = fromJust mbCoreModSem- -- ehInh' = ehInh- -- { EHSem.dataGam_Inh_AGItf = EHSem.dataGam_Inh_AGItf ehInh `gamUnionFlow` Core2ChkSem.gathDataGam_Syn_CodeAGItf coreModSem- -- } coreInh' = coreInh { Core2GrSem.dataGam_Inh_CodeAGItf = Core2GrSem.dataGam_Inh_CodeAGItf coreInh `gamUnionFlow` Core2ChkSem.gathDataGam_Syn_CodeAGItf coreModSem }- -- ; lift $ putStrLn $ "cpFlowCoreModSem" ++ (show $ gamKeys $ Core2ChkSem.gathDataGam_Syn_CodeAGItf coreModSem)- -- ; cpUpdSI (\crsi -> crsi { crsiEHInh = ehInh' }) ; cpUpdSI (\crsi -> crsi { crsiCoreInh = coreInh' }) } } -{-# LINE 320 "src/ehc/EHC/CompilePhase/FlowBetweenPhase.chs" #-}-cpFlowCoreSemAfterFold :: HsName -> EHCompilePhase ()+{-# LINE 314 "src/ehc/EHC/CompilePhase/FlowBetweenPhase.chs" #-}+cpFlowCoreSemAfterFold :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpFlowCoreSemAfterFold modNm = do { cr <- get ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr@@ -236,7 +230,7 @@ }) } -cpFlowCoreSemBeforeFold :: HsName -> EHCompilePhase ()+cpFlowCoreSemBeforeFold :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpFlowCoreSemBeforeFold modNm = do { cr <- get ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr@@ -250,8 +244,8 @@ { -- 20100717 AD: required here because of inlining etc, TBD HI.hiiHIUsedImpModS = usedImpS }- -- ; lift $ putStrLn $ "cpFlowCoreSemBeforeFold usedImpS " ++ show usedImpS- -- ; lift $ putStrLn $ "cpFlowCoreSemBeforeFold introdModS " ++ show introdModS+ -- ; liftIO $ putStrLn $ "cpFlowCoreSemBeforeFold usedImpS " ++ show usedImpS+ -- ; liftIO $ putStrLn $ "cpFlowCoreSemBeforeFold introdModS " ++ show introdModS ; cpUpdCU modNm ( ecuStoreHIInfo hii' -- -- 20100717 AD: required here because of inlining etc, TBD@@ -263,8 +257,8 @@ ) } -{-# LINE 371 "src/ehc/EHC/CompilePhase/FlowBetweenPhase.chs" #-}-cpFlowHILamMp :: HsName -> EHCompilePhase ()+{-# LINE 365 "src/ehc/EHC/CompilePhase/FlowBetweenPhase.chs" #-}+cpFlowHILamMp :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpFlowHILamMp modNm = do { cr <- get ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr@@ -275,8 +269,8 @@ ; cpUpdSI (\crsi -> crsi {crsiCoreInh = coreInh {Core2GrSem.lamMp_Inh_CodeAGItf = HI.hiiLamMp hii `lamMpUnionBindAspMp` Core2GrSem.lamMp_Inh_CodeAGItf coreInh}}) } -{-# LINE 384 "src/ehc/EHC/CompilePhase/FlowBetweenPhase.chs" #-}-cpFlowOptim :: HsName -> EHCompilePhase ()+{-# LINE 378 "src/ehc/EHC/CompilePhase/FlowBetweenPhase.chs" #-}+cpFlowOptim :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpFlowOptim modNm = do { cr <- get ; let (ecu,crsi,_,_) = crBaseInfo modNm cr@@ -288,7 +282,7 @@ ; when (isJust (ecuMbOptim ecu)) (do { cpUpdSI (\crsi -> crsi {crsiOptim = optim'}) ; cpUpdCU modNm $! ecuStoreHIInfo $! prepFlow hii'- -- ; lift $ putStrLn (forceEval hii' `seq` "cpFlowOptim")+ -- ; liftIO $ putStrLn (forceEval hii' `seq` "cpFlowOptim") }) }
@@ -10,7 +10,7 @@ import UHC.Light.Compiler.Base.Target {-# LINE 37 "src/ehc/EHC/CompilePhase/Link.chs" #-}-cpLinkO :: [HsName] -> String -> EHCompilePhase ()+cpLinkO :: EHCCompileRunner m => [HsName] -> String -> EHCompilePhaseT m () cpLinkO modNmL pkgNm = do { cr <- get ; let (crsi,opts) = crBaseInfo' cr@@ -19,7 +19,7 @@ where l = mkFPath $ Cfg.mkCLibFilename "" pkgNm linkCode = map mkShellCmd $ Cfg.mkShellCmdLibtool (fpathToStr libFile) codeFiles ; when (ehcOptVerbosity opts >= VerboseALot)- (do { lift $ mapM_ (putStrLn . showShellCmd) linkCode+ (do { liftIO $ mapM_ (putStrLn . showShellCmd) linkCode }) ; unless (null codeFiles) (cpSeq [ cpSystem c | c <- linkCode ])
@@ -4,6 +4,7 @@ , cpCheckModsWithBuiltin , cpCheckModsWithoutBuiltin , GetMeta (..), allGetMeta+, cpGetCoreRunModnameAndImports , cpGetCoreModnameAndImports , cpGetHsModnameAndImports, cpGetHsMod, cpGetMetaInfo , cpGetDummyCheckSrcMod@@ -26,15 +27,17 @@ import qualified UHC.Light.Compiler.Config as Cfg import qualified UHC.Light.Compiler.HS.ModImpExp as HSSemMod import qualified UHC.Light.Compiler.Core.Check as Core2ChkSem+import qualified UHC.Light.Compiler.CoreRun.Check as CoreRun2ChkSem import UHC.Light.Compiler.CodeGen.RefGenerator import UHC.Light.Compiler.Base.Debug -{-# LINE 53 "src/ehc/EHC/CompilePhase/Module.chs" #-}++{-# LINE 55 "src/ehc/EHC/CompilePhase/Module.chs" #-} -- | Check module dependencies for given 'Mod'-cpCheckModsModWith :: (HsName -> ModMpInfo) -> [Mod] -> EHCompilePhase ()+cpCheckModsModWith :: EHCCompileRunner m => (HsName -> ModMpInfo) -> [Mod] -> EHCompilePhaseT m () cpCheckModsModWith dfltMod modL@(Mod {modName = modNm} : _) = do { cr <- get ; cpMsg modNm VerboseDebug $ "cpCheckModsModWith modL: " ++ show modL@@ -44,8 +47,8 @@ ; cpSetLimitErrsWhen 5 "Module analysis" e } -{-# LINE 73 "src/ehc/EHC/CompilePhase/Module.chs" #-}-cpCheckModsWithOrWithoutBuiltin :: Bool -> [HsName] -> EHCompilePhase ()+{-# LINE 75 "src/ehc/EHC/CompilePhase/Module.chs" #-}+cpCheckModsWithOrWithoutBuiltin :: EHCCompileRunner m => Bool -> [HsName] -> EHCompilePhaseT m () cpCheckModsWithOrWithoutBuiltin bltin modNmL@(modNm:_) = do { cr <- get ; cpMsg modNm VerboseDebug $ "cpCheckModsWithOrWithoutBuiltin modNmL: " ++ show modNmL@@ -55,32 +58,54 @@ where addBuiltin | bltin = \m -> m { modImpL = modImpBuiltin : modImpL m } | otherwise = id -{-# LINE 85 "src/ehc/EHC/CompilePhase/Module.chs" #-}-cpCheckModsWithBuiltin :: [HsName] -> EHCompilePhase ()+{-# LINE 87 "src/ehc/EHC/CompilePhase/Module.chs" #-}+cpCheckModsWithBuiltin :: EHCCompileRunner m => [HsName] -> EHCompilePhaseT m () cpCheckModsWithBuiltin = cpCheckModsWithOrWithoutBuiltin True {-# INLINE cpCheckModsWithBuiltin #-} -{-# LINE 91 "src/ehc/EHC/CompilePhase/Module.chs" #-}-cpCheckModsWithoutBuiltin :: [HsName] -> EHCompilePhase ()+{-# LINE 93 "src/ehc/EHC/CompilePhase/Module.chs" #-}+cpCheckModsWithoutBuiltin :: EHCCompileRunner m => [HsName] -> EHCompilePhaseT m () cpCheckModsWithoutBuiltin = cpCheckModsWithOrWithoutBuiltin False {-# INLINE cpCheckModsWithoutBuiltin #-} -{-# LINE 101 "src/ehc/EHC/CompilePhase/Module.chs" #-}+{-# LINE 103 "src/ehc/EHC/CompilePhase/Module.chs" #-} data GetMeta = GetMeta_Src | GetMeta_HI | GetMeta_Core+ | GetMeta_CoreRun | GetMeta_Dir deriving (Eq,Ord) allGetMeta- = [ GetMeta_Src, GetMeta_HI, GetMeta_Core+ = [ GetMeta_Src+ , GetMeta_HI+ , GetMeta_Core+ , GetMeta_CoreRun , GetMeta_Dir ] -{-# LINE 122 "src/ehc/EHC/CompilePhase/Module.chs" #-}-cpGetCoreModnameAndImports :: HsName -> EHCompilePhase HsName+{-# LINE 132 "src/ehc/EHC/CompilePhase/Module.chs" #-}+cpGetCoreRunModnameAndImports :: EHCCompileRunner m => HsName -> EHCompilePhaseT m HsName+cpGetCoreRunModnameAndImports modNm+ = do { cr <- get+ ; let (ecu,_,opts,_) = crBaseInfo modNm cr+ mbCrSemMod = ecuMbCoreRunSemMod ecu+ crSemMod = panicJust "cpGetCoreRunModnameAndImports" mbCrSemMod+ modNm' = CoreRun2ChkSem.realModuleNm_Syn_AGItf crSemMod+ ; cpMsg modNm VerboseDebug $ "cpGetCoreRunModnameAndImports: " ++ show modNm ++ " -> " ++ show modNm'+ ; case mbCrSemMod of+ Just _ -> cpUpdCUWithKey modNm $ \_ ecu ->+ ( modNm'+ , ecuStoreHSDeclImpS (Set.fromList $ CoreRun2ChkSem.impModNmL_Syn_AGItf crSemMod )+ $ cuUpdKey modNm' ecu+ )+ _ -> return modNm+ }++{-# LINE 151 "src/ehc/EHC/CompilePhase/Module.chs" #-}+cpGetCoreModnameAndImports :: EHCCompileRunner m => HsName -> EHCompilePhaseT m HsName cpGetCoreModnameAndImports modNm = do { cr <- get ; let (ecu,_,opts,_) = crBaseInfo modNm cr@@ -89,10 +114,6 @@ modNm' = Core2ChkSem.realModuleNm_Syn_CodeAGItf crSemMod ; cpMsg modNm VerboseDebug $ "cpGetCoreModnameAndImports: " ++ show modNm ++ " -> " ++ show modNm' ; case mbCrSemMod of- {-- Just _ | ecuIsTopMod ecu -> cpUpdCUWithKey modNm (\_ ecu -> (modNm', upd $ cuUpdKey modNm' ecu))- | otherwise -> do { cpUpdCU modNm upd ; return modNm }- -} Just _ -> cpUpdCUWithKey modNm $ \_ ecu -> ( modNm' , ecuStoreHSDeclImpS (Set.fromList $ Core2ChkSem.impModNmL_Syn_CodeAGItf crSemMod )@@ -101,8 +122,8 @@ _ -> return modNm } -{-# LINE 145 "src/ehc/EHC/CompilePhase/Module.chs" #-}-cpGetHsModnameAndImports :: HsName -> EHCompilePhase HsName+{-# LINE 170 "src/ehc/EHC/CompilePhase/Module.chs" #-}+cpGetHsModnameAndImports :: EHCCompileRunner m => HsName -> EHCompilePhaseT m HsName cpGetHsModnameAndImports modNm = do { cr <- get ; let (ecu,_,opts,_) = crBaseInfo modNm cr@@ -117,7 +138,7 @@ _ -> return modNm } -cpGetHsMod :: HsName -> EHCompilePhase ()+cpGetHsMod :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpGetHsMod modNm = do { cr <- get ; let (ecu,_,opts,_) = crBaseInfo modNm cr@@ -126,13 +147,13 @@ mod = HSSemMod.mod_Syn_AGItf hsSemMod ; when (ehcOptVerbosity opts >= VerboseDebug) (do { cpMsg modNm VerboseDebug "cpGetHsMod"- ; lift $ putWidthPPLn 120 (pp mod)+ ; liftIO $ putWidthPPLn 120 (pp mod) }) ; when (isJust mbHsSemMod) (cpUpdCU modNm (ecuStoreMod mod)) } -cpGetMetaInfo :: [GetMeta] -> HsName -> EHCompilePhase ()+cpGetMetaInfo :: EHCCompileRunner m => [GetMeta] -> HsName -> EHCompilePhaseT m () cpGetMetaInfo gm modNm = do { cr <- get ; let (ecu,_,opts,fp) = crBaseInfo modNm cr@@ -150,32 +171,34 @@ ) ; when (GetMeta_Core `elem` gm) (tm opts ecu ecuStoreCoreTime (fpathSetSuff Cfg.suffixDotlessBinaryCore fp))+ ; when (GetMeta_CoreRun `elem` gm)+ (tm opts ecu ecuStoreCoreRunTime (fpathSetSuff Cfg.suffixDotlessBinaryCoreRun fp)) ; when (GetMeta_Dir `elem` gm) (wr opts ecu ecuStoreDirIsWritable ( fp )) }- where tm :: EHCOpts -> EHCompileUnit -> (ClockTime -> EHCompileUnit -> EHCompileUnit) -> FPath -> EHCompilePhase ()+ where tm :: EHCCompileRunner m => EHCOpts -> EHCompileUnit -> (ClockTime -> EHCompileUnit -> EHCompileUnit) -> FPath -> EHCompilePhaseT m () tm opts ecu store fp = do { let n = fpathToStr fp- ; nExists <- lift $ doesFileExist n+ ; nExists <- liftIO $ doesFileExist n ; when (ehcOptVerbosity opts >= VerboseDebug)- (do { lift $ putStrLn ("meta info of: " ++ show (ecuModNm ecu) ++ ", file: " ++ n ++ ", exists: " ++ show nExists)+ (do { liftIO $ putStrLn ("meta info of: " ++ show (ecuModNm ecu) ++ ", file: " ++ n ++ ", exists: " ++ show nExists) }) ; when nExists- (do { t <- lift $ fpathGetModificationTime fp+ (do { t <- liftIO $ fpathGetModificationTime fp ; when (ehcOptVerbosity opts >= VerboseDebug)- (do { lift $ putStrLn ("time stamp of: " ++ show (ecuModNm ecu) ++ ", time: " ++ show t)+ (do { liftIO $ putStrLn ("time stamp of: " ++ show (ecuModNm ecu) ++ ", time: " ++ show t) }) ; cpUpdCU modNm $ store t }) } wr opts ecu store fp- = do { pm <- lift $ getPermissions (maybe "." id $ fpathMbDir fp)- -- ; lift $ putStrLn (fpathToStr fp ++ " writ " ++ show (writable pm))+ = do { pm <- liftIO $ getPermissions (maybe "." id $ fpathMbDir fp)+ -- ; liftIO $ putStrLn (fpathToStr fp ++ " writ " ++ show (writable pm)) ; cpUpdCU modNm $ store (writable pm) } -{-# LINE 241 "src/ehc/EHC/CompilePhase/Module.chs" #-}-cpGetDummyCheckSrcMod :: HsName -> EHCompilePhase ()+{-# LINE 270 "src/ehc/EHC/CompilePhase/Module.chs" #-}+cpGetDummyCheckSrcMod :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpGetDummyCheckSrcMod modNm = do { cr <- get ; let crsi = crStateInfo cr@@ -185,8 +208,8 @@ ; cpUpdSI (\crsi -> crsi {crsiModMp = Map.insert modNm emptyModMpInfo mm}) } -{-# LINE 257 "src/ehc/EHC/CompilePhase/Module.chs" #-}-cpUpdateModOffMp :: [HsName] -> EHCompilePhase ()+{-# LINE 286 "src/ehc/EHC/CompilePhase/Module.chs" #-}+cpUpdateModOffMp :: EHCCompileRunner m => [HsName] -> EHCompilePhaseT m () cpUpdateModOffMp modNmL@(modNm:_) = do { cr <- get ; cpMsg modNm VerboseDebug "cpUpdateModOffMp"@@ -203,9 +226,9 @@ ; cpUpdSI (\crsi -> crsi {crsiModOffMp = offMp'}) } -{-# LINE 280 "src/ehc/EHC/CompilePhase/Module.chs" #-}+{-# LINE 309 "src/ehc/EHC/CompilePhase/Module.chs" #-} -- | Compute imported module names-cpGenImpNmInfo :: HsName -> EHCompilePhase [HsName]+cpGenImpNmInfo :: EHCCompileRunner m => HsName -> EHCompilePhaseT m [HsName] cpGenImpNmInfo modNm = do { cr <- get ; let (ecu,crsi,opts,fp) = crBaseInfo modNm cr@@ -215,8 +238,8 @@ ; return impNmL } -{-# LINE 297 "src/ehc/EHC/CompilePhase/Module.chs" #-}-cpUpdHiddenExports :: HsName -> [(HsName,IdOccKind)] -> EHCompilePhase ()+{-# LINE 326 "src/ehc/EHC/CompilePhase/Module.chs" #-}+cpUpdHiddenExports :: EHCCompileRunner m => HsName -> [(HsName,IdOccKind)] -> EHCompilePhaseT m () cpUpdHiddenExports modNm exps = when (not $ null exps) (do { cpUpdSI (\crsi -> crsi { crsiModMp = modMpAddHiddenExps modNm exps $ crsiModMp crsi
@@ -1,6 +1,8 @@ module UHC.Light.Compiler.EHC.CompilePhase.Output ( CPOutputCoreHow (..), cpOutputCoreModules , cpOutputCore+, CPOutputCoreRunHow (..), cpOutputCoreRunModules+, cpOutputCoreRun , cpOutputHI ) where import qualified UHC.Util.FastSeq as Seq@@ -13,6 +15,7 @@ import qualified UHC.Light.Compiler.Config as Cfg import qualified UHC.Light.Compiler.Core.ToGrin as Core2GrSem import UHC.Light.Compiler.Core.Trf.EraseExtractTysigCore+import UHC.Light.Compiler.CoreRun as CoreRun import UHC.Light.Compiler.Core.ToCoreRun import UHC.Light.Compiler.CoreRun.Pretty import UHC.Light.Compiler.Core as Core@@ -42,36 +45,39 @@ {-# LINE 93 "src/ehc/EHC/CompilePhase/Output.chs" #-} -- | Abstraction for writing a module to output with variation in suffices cpOutputSomeModules- :: (EHCOpts -> EHCompileUnit -> FPath -> FilePath -> mod -> IO ())+ :: EHCCompileRunner m =>+ (EHCOpts -> EHCompileUnit -> FPath -> FilePath -> mod -> IO ()) -> (EHCOpts -> HsName -> FPath -> String -> FPath) -> (Int -> String -> String) -> String -> HsName -> [(String,mod)]- -> EHCompilePhase [FPath]+ -> EHCompilePhaseT m [FPath] cpOutputSomeModules write mkfp mknmsuff suff modNm mods = do cr <- get let (ecu,crsi,opts,fp) = crBaseInfo modNm cr forM (zip [1..] mods) $ \(nr,(nmsuff,mod)) -> do let fpC = mkfp opts modNm fp (suff ++ mknmsuff nr nmsuff) -- for now nmsuff after suff, but should be inside name fnC = fpathToStr fpC- lift $ do+ liftIO $ unless (ecuSrcHasSuffix suff ecu) $ do fpathEnsureExists fpC write opts ecu fpC fnC mod return fpC -{-# LINE 151 "src/ehc/EHC/CompilePhase/Output.chs" #-}+{-# LINE 152 "src/ehc/EHC/CompilePhase/Output.chs" #-} data CPOutputCoreHow = CPOutputCoreHow_Text | CPOutputCoreHow_Binary- | CPOutputCoreHow_Run+ | CPOutputCoreHow_CoreRun_Text+ | CPOutputCoreHow_CoreRun_Binary cpOutputCoreModules- :: CPOutputCoreHow -> [CoreOpt]+ :: EHCCompileRunner m =>+ CPOutputCoreHow -> [CoreOpt] -> (Int -> String -> String) -> String -> HsName -> [(String,CModule)]- -> EHCompilePhase [FPath]+ -> EHCompilePhaseT m [FPath] cpOutputCoreModules how coreOpts mknmsuff suff modNm cMods = do { cr <- get ; let (_,opts) = crBaseInfo' cr@@ -83,12 +89,15 @@ putPPFPath fpC (ppCModule (opts {ehcOptCoreOpts = coreOpts ++ ehcOptCoreOpts opts}) cMod') 100 CPOutputCoreHow_Binary -> putSerializeFile fnC cMod- CPOutputCoreHow_Run -> do+ CPOutputCoreHow_CoreRun_Text -> do let cMod' = cmod2CoreRun cMod putPPFPath fpC (ppMod' opts cMod') 100+ CPOutputCoreHow_CoreRun_Binary -> do+ let cMod' = cmod2CoreRun cMod+ putSerializeFile fnC cMod' -{-# LINE 187 "src/ehc/EHC/CompilePhase/Output.chs" #-}-cpOutputCore :: CPOutputCoreHow -> [CoreOpt] -> String -> String -> HsName -> EHCompilePhase FPath+{-# LINE 197 "src/ehc/EHC/CompilePhase/Output.chs" #-}+cpOutputCore :: EHCCompileRunner m => CPOutputCoreHow -> [CoreOpt] -> String -> String -> HsName -> EHCompilePhaseT m FPath cpOutputCore how coreOpts nmsuff suff modNm = do { cr <- get ; let (ecu,_,_,_) = crBaseInfo modNm cr@@ -98,8 +107,43 @@ ; fmap head $ cpOutputCoreModules how coreOpts (\_ nm -> nm) suff modNm [(nmsuff,cMod)] } -{-# LINE 314 "src/ehc/EHC/CompilePhase/Output.chs" #-}-cpOutputHI :: String -> HsName -> EHCompilePhase ()+{-# LINE 209 "src/ehc/EHC/CompilePhase/Output.chs" #-}+data CPOutputCoreRunHow+ = CPOutputCoreRunHow_Text+ | CPOutputCoreRunHow_Binary++cpOutputCoreRunModules+ :: EHCCompileRunner m =>+ CPOutputCoreRunHow+ -> (Int -> String -> String)+ -> String -> HsName+ -> [(String,CoreRun.Mod)]+ -> EHCompilePhaseT m [FPath]+cpOutputCoreRunModules how mknmsuff suff modNm crMods+ = do { cr <- get+ ; let (_,opts) = crBaseInfo' cr+ ; cpOutputSomeModules write mkOutputFPath mknmsuff suff modNm crMods+ }+ where write opts _ fpC fnC crMod = case how of+ CPOutputCoreRunHow_Text ->+ putPPFPath fpC (ppMod' opts crMod) 100+ CPOutputCoreRunHow_Binary ->+ putSerializeFile fnC crMod+++{-# LINE 238 "src/ehc/EHC/CompilePhase/Output.chs" #-}+cpOutputCoreRun :: EHCCompileRunner m => CPOutputCoreRunHow -> String -> String -> HsName -> EHCompilePhaseT m FPath+cpOutputCoreRun how nmsuff suff modNm+ = do { cr <- get+ ; let (ecu,_,_,_) = crBaseInfo modNm cr+ mbCoreRun = ecuMbCoreRun ecu+ cMod = panicJust "cpOutputCoreRun" mbCoreRun+ ; cpMsg modNm VerboseALot "Emit CoreRun"+ ; fmap head $ cpOutputCoreRunModules how (\_ nm -> nm) suff modNm [(nmsuff,cMod)]+ }++{-# LINE 381 "src/ehc/EHC/CompilePhase/Output.chs" #-}+cpOutputHI :: EHCCompileRunner m => String -> HsName -> EHCompilePhaseT m () cpOutputHI suff modNm = do { cr <- get ; let (ecu,crsi,opts,fp) = crBaseInfo modNm cr@@ -133,18 +177,18 @@ fpH = mkOutputFPath opts modNm fp suff fnH = fpathToStr fpH ; cpMsg modNm VerboseALot "Emit HI"- ; hiExists <- lift $ doesFileExist fnH+ ; hiExists <- liftIO $ doesFileExist fnH ; when (hiExists)- (lift $ removeFile fnH)+ (liftIO $ removeFile fnH) ; when (ehcOptVerbosity opts > VerboseALot)- (do { lift $ putPPLn ("hii3: " >#< hii3)- ; lift $ putPPLn ("orph: " >#< vlist [ m >#< (fmap Set.toList $ HI.hiiMbOrphan $ ecuHIInfo me) | m <- Set.toList impNmS, let me = crCU m cr ])- ; lift $ putPPLn ("used nms: " >#< (pp $ show $ ecuUsedNames ecu))+ (do { liftIO $ putPPLn ("hii3: " >#< hii3)+ ; liftIO $ putPPLn ("orph: " >#< vlist [ m >#< (fmap Set.toList $ HI.hiiMbOrphan $ ecuHIInfo me) | m <- Set.toList impNmS, let me = crCU m cr ])+ ; liftIO $ putPPLn ("used nms: " >#< (pp $ show $ ecuUsedNames ecu)) })- ; lift $ do { fpathEnsureExists fpH+ ; liftIO $ do { fpathEnsureExists fpH ; putSerializeFile fnH hii3 }- ; now <- lift $ getClockTime+ ; now <- liftIO $ getClockTime ; cpUpdCU modNm ( ecuStoreHIInfoTime now . ecuStoreHIInfo hii3 )
@@ -5,8 +5,10 @@ , cpParseOffsideStopAtErr , cpDecodeHIInfo , cpDecodeCore+, cpDecodeCoreRun , cpGetPrevHI , cpGetPrevCore+, cpGetPrevCoreRun , cpParseHs , cpParseHsImport ) where@@ -25,6 +27,7 @@ import qualified UHC.Light.Compiler.HS.Parser as HSPrs import qualified UHC.Light.Compiler.Core as Core import qualified UHC.Light.Compiler.Core.Parser as CorePrs+import qualified UHC.Light.Compiler.CoreRun as CoreRun import qualified UHC.Light.Compiler.HI as HI import qualified UHC.Util.Binary as Bin import UHC.Util.Serialize@@ -38,25 +41,26 @@ -{-# LINE 61 "src/ehc/EHC/CompilePhase/Parsers.chs" #-}++{-# LINE 64 "src/ehc/EHC/CompilePhase/Parsers.chs" #-} -- | Generalization of parser invocation cpParseWithFPath- :: PP msg+ :: (EHCCompileRunner m, PP msg) => (ScanUtils.ScanOpts -> FilePath -> Handle -> IO inp) -- tokenize/scan file -> (parser -> inp -> (a,[msg])) -- parse tokens- -> ([Err] -> EHCompilePhase out) -- monadic output from errors+ -> ([Err] -> EHCompilePhaseT m out) -- monadic output from errors -> parser -- the parser -> ScanUtils.ScanOpts -- options to the tokenizer/scanner -> EcuUpdater a -- updater of state -> Maybe FPath -- possibly overriding FilePath instead of default derived from state for this module name -> HsName -- module name- -> EHCompilePhase out+ -> EHCompilePhaseT m out cpParseWithFPath scan parse seterrs parser scanOpts store mbFp modNm = do { cr <- get- ; (fn,fh) <- lift $ openFPath (maybe (ecuFilePath (crCU modNm cr)) id mbFp) ReadMode False- ; tokens <- lift $ scan scanOpts fn fh+ ; (fn,fh) <- liftIO $ openFPath (maybe (ecuFilePath (crCU modNm cr)) id mbFp) ReadMode False+ ; tokens <- liftIO $ scan scanOpts fn fh ; let (res,msgs) = parse parser tokens errs = map (rngLift emptyRange mkPPErr) msgs ; cpUpdCU modNm (store res)@@ -65,14 +69,14 @@ -- cpParseOffsideWithFPath :: HSPrs.HSParser a -> ScanUtils.ScanOpts -> EcuUpdater a -> String -> Maybe FPath -> HsName -> EHCompilePhase () -- `HSPrs.HSParser a' is a type synonym for `OffsideParser [Token] Pair Token (Maybe Token) a' but is not expanded as such...-cpParseOffsideWithFPath :: OffsideParser [Token] Pair Token (Maybe Token) a -> ScanUtils.ScanOpts -> EcuUpdater a -> String -> Maybe FPath -> HsName -> EHCompilePhase ()+cpParseOffsideWithFPath :: EHCCompileRunner m => OffsideParser [Token] Pair Token (Maybe Token) a -> ScanUtils.ScanOpts -> EcuUpdater a -> String -> Maybe FPath -> HsName -> EHCompilePhaseT m () cpParseOffsideWithFPath parser scanOpts store description mbFp modNm = cpParseWithFPath offsideScanHandle parseOffsideToResMsgs (cpSetLimitErrsWhen 5 description) parser scanOpts store mbFp modNm {- = do { cr <- get- ; (fn,fh) <- lift $ openFPath (maybe (ecuFilePath (crCU modNm cr)) id mbFp) ReadMode False- ; tokens <- lift $ offsideScanHandle scanOpts fn fh- -- ; lift $ putStrLn $ show tokens -- does not work, no Show instance+ ; (fn,fh) <- liftIO $ openFPath (maybe (ecuFilePath (crCU modNm cr)) id mbFp) ReadMode False+ ; tokens <- liftIO $ offsideScanHandle scanOpts fn fh+ -- ; liftIO $ putStrLn $ show tokens -- does not work, no Show instance ; let (res,msgs) = parseOffsideToResMsgs parser tokens errs = map (rngLift emptyRange mkPPErr) msgs ; cpUpdCU modNm (store res)@@ -80,18 +84,18 @@ } -} -{-# LINE 104 "src/ehc/EHC/CompilePhase/Parsers.chs" #-}-cpParseOffside :: HSPrs.HSParser a -> ScanUtils.ScanOpts -> EcuUpdater a -> String -> HsName -> EHCompilePhase ()+{-# LINE 107 "src/ehc/EHC/CompilePhase/Parsers.chs" #-}+cpParseOffside :: EHCCompileRunner m => HSPrs.HSParser a -> ScanUtils.ScanOpts -> EcuUpdater a -> String -> HsName -> EHCompilePhaseT m () cpParseOffside parser scanOpts store description modNm = cpParseOffsideWithFPath parser scanOpts store description Nothing modNm -{-# LINE 135 "src/ehc/EHC/CompilePhase/Parsers.chs" #-}-cpParseEH :: HsName -> EHCompilePhase ()+{-# LINE 138 "src/ehc/EHC/CompilePhase/Parsers.chs" #-}+cpParseEH :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpParseEH = cpParseOffside EHPrs.pAGItf (ehScanOpts defaultEHCOpts) ecuStoreEH "Parse (EH syntax) of module" -{-# LINE 162 "src/ehc/EHC/CompilePhase/Parsers.chs" #-}-cpParseHs :: Bool -> HsName -> EHCompilePhase ()+{-# LINE 165 "src/ehc/EHC/CompilePhase/Parsers.chs" #-}+cpParseHs :: EHCCompileRunner m => Bool -> HsName -> EHCompilePhaseT m () cpParseHs litmode modNm = do { cr <- get ; let (ecu,_,opts,_) = crBaseInfo modNm cr@@ -101,32 +105,32 @@ Nothing modNm } -{-# LINE 174 "src/ehc/EHC/CompilePhase/Parsers.chs" #-}-cpParseOffsideStopAtErr :: HSPrs.HSParser a -> ScanUtils.ScanOpts -> EcuUpdater a -> HsName -> EHCompilePhase ()+{-# LINE 177 "src/ehc/EHC/CompilePhase/Parsers.chs" #-}+cpParseOffsideStopAtErr :: EHCCompileRunner m => HSPrs.HSParser a -> ScanUtils.ScanOpts -> EcuUpdater a -> HsName -> EHCompilePhaseT m () cpParseOffsideStopAtErr parser scanOpts store modNm = do { cr <- get- ; (fn,fh) <- lift $ openFPath (ecuFilePath (crCU modNm cr)) ReadMode False- ; tokens <- lift $ offsideScanHandle scanOpts fn fh+ ; (fn,fh) <- liftIO $ openFPath (ecuFilePath (crCU modNm cr)) ReadMode False+ ; tokens <- liftIO $ offsideScanHandle scanOpts fn fh ; let (res,_) = parseOffsideToResMsgsStopAtErr parser tokens ; cpUpdCU modNm (store res) } -{-# LINE 194 "src/ehc/EHC/CompilePhase/Parsers.chs" #-}-cpParseHsImport :: Bool -> HsName -> EHCompilePhase ()+{-# LINE 197 "src/ehc/EHC/CompilePhase/Parsers.chs" #-}+cpParseHsImport :: EHCCompileRunner m => Bool -> HsName -> EHCompilePhaseT m () cpParseHsImport litmode modNm = do { cr <- get ; let (_,opts) = crBaseInfo' cr ; cpParseOffsideStopAtErr (HSPrs.pAGItfImport opts) ((hsScanOpts opts) {ScanUtils.scoLitmode = litmode}) ecuStoreHS modNm } -{-# LINE 203 "src/ehc/EHC/CompilePhase/Parsers.chs" #-}-cpParseCoreWithFPath :: Maybe FPath -> HsName -> EHCompilePhase ()+{-# LINE 206 "src/ehc/EHC/CompilePhase/Parsers.chs" #-}+cpParseCoreWithFPath :: EHCCompileRunner m => Maybe FPath -> HsName -> EHCompilePhaseT m () cpParseCoreWithFPath mbFp modNm = do (_,opts) <- gets crBaseInfo' cpParseWithFPath scanHandle parseToResMsgs (cpSetLimitErrsWhen 5 "Parse Core") CorePrs.pCModule (coreScanOpts opts) ecuStoreCore mbFp modNm {--cpParseCore :: HsName -> EHCompilePhase ()+cpParseCore :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpParseCore modNm = do { cr <- get ; let (ecu,_,opts,fp) = crBaseInfo modNm cr@@ -139,15 +143,15 @@ } -} -{-# LINE 248 "src/ehc/EHC/CompilePhase/Parsers.chs" #-}-cpDecodeHIInfo :: HsName -> EHCompilePhase ()+{-# LINE 251 "src/ehc/EHC/CompilePhase/Parsers.chs" #-}+cpDecodeHIInfo :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpDecodeHIInfo modNm = do { cr <- get ; let (ecu,_,opts,fp) = crBaseInfo modNm cr -- if outputdir is specified, use that location to possibly read hi from. fpH = mkInOrOutputFPathFor (InputFrom_Loc $ ecuFileLocation ecu) opts modNm fp "hi" ; cpMsg' modNm VerboseALot "Decoding" Nothing fpH- ; hiinfo <- lift $+ ; hiinfo <- liftIO $ CE.catch (do { i <- getSGetFile (fpathToStr fpH) (HI.sgetHIInfo opts) -- getSerializeFile (fpathToStr fpH) -- Bin.getBinaryFPath fpH@@ -155,7 +159,7 @@ }) (\(_ :: SomeException) -> return $ HI.emptyHIInfo {HI.hiiValidity = HI.HIValidity_Absent}) ; when (ehcOptVerbosity opts > VerboseALot)- (do { lift $ putPPLn (pp hiinfo)+ (do { liftIO $ putPPLn (pp hiinfo) }) ; let canCompile = crModCanCompile modNm cr ; case HI.hiiValidity hiinfo of@@ -176,9 +180,9 @@ _ -> cpUpdCU modNm (ecuStorePrevHIInfo {-- $ HI.hiiPostCheckValidity opts -} hiinfo) } -{-# LINE 294 "src/ehc/EHC/CompilePhase/Parsers.chs" #-}+{-# LINE 297 "src/ehc/EHC/CompilePhase/Parsers.chs" #-} -- | Decode from serialized file and store result in the compileunit for the module modNm-cpDecode :: Serialize x => Maybe String -> EcuUpdater x -> HsName -> EHCompilePhase ()+cpDecode :: (EHCCompileRunner m, Serialize x) => Maybe String -> EcuUpdater x -> HsName -> EHCompilePhaseT m () cpDecode mbSuff store modNm = do { cr <- get ; let (ecu,_,opts,fp) = crBaseInfo modNm cr@@ -188,12 +192,16 @@ ; cpUpdCU modNm (store x) } -{-# LINE 312 "src/ehc/EHC/CompilePhase/Parsers.chs" #-}-cpDecodeCore :: Maybe String -> HsName -> EHCompilePhase ()+{-# LINE 315 "src/ehc/EHC/CompilePhase/Parsers.chs" #-}+cpDecodeCore :: EHCCompileRunner m => Maybe String -> HsName -> EHCompilePhaseT m () cpDecodeCore suff = cpDecode suff ecuStoreCore -{-# LINE 321 "src/ehc/EHC/CompilePhase/Parsers.chs" #-}-cpGetPrevHI :: HsName -> EHCompilePhase ()+{-# LINE 320 "src/ehc/EHC/CompilePhase/Parsers.chs" #-}+cpDecodeCoreRun :: EHCCompileRunner m => Maybe String -> HsName -> EHCompilePhaseT m ()+cpDecodeCoreRun suff = cpDecode suff ecuStoreCore++{-# LINE 329 "src/ehc/EHC/CompilePhase/Parsers.chs" #-}+cpGetPrevHI :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpGetPrevHI modNm = do { cr <- get ; cpMsg modNm VerboseDebug "cpGetPrevHI"@@ -204,8 +212,8 @@ (cpDecodeHIInfo modNm) } -{-# LINE 334 "src/ehc/EHC/CompilePhase/Parsers.chs" #-}-cpGetPrevCore :: HsName -> EHCompilePhase Core.CModule+{-# LINE 342 "src/ehc/EHC/CompilePhase/Parsers.chs" #-}+cpGetPrevCore :: EHCCompileRunner m => HsName -> EHCompilePhaseT m Core.CModule cpGetPrevCore modNm = do { cr <- get ; cpMsg modNm VerboseDebug "cpGetPrevCore"@@ -214,5 +222,16 @@ (cpDecodeCore (Just Cfg.suffixDotlessBinaryCore) modNm) -- (cpParseCore modNm) ; fmap (fromJust . ecuMbCore) $ gets (crCU modNm)+ }++{-# LINE 355 "src/ehc/EHC/CompilePhase/Parsers.chs" #-}+cpGetPrevCoreRun :: EHCCompileRunner m => HsName -> EHCompilePhaseT m CoreRun.Mod+cpGetPrevCoreRun modNm+ = do { cr <- get+ ; cpMsg modNm VerboseDebug "cpGetPrevCoreRun"+ ; let ecu = crCU modNm cr+ ; when (isJust (ecuMbCoreRunTime ecu) && isNothing (ecuMbCoreRun ecu))+ (cpDecodeCoreRun (Just Cfg.suffixDotlessBinaryCoreRun) modNm)+ ; fmap (fromJust . ecuMbCoreRun) $ gets (crCU modNm) }
@@ -1,6 +1,7 @@ module UHC.Light.Compiler.EHC.CompilePhase.Run ( cpRunCoreRun-, cpRunCoreRun2 )+, cpRunCoreRun2+, cpRunCoreRun3 ) where import UHC.Light.Compiler.EHC.Common import UHC.Light.Compiler.EHC.CompileUnit@@ -17,7 +18,7 @@ {-# LINE 45 "src/ehc/EHC/CompilePhase/Run.chs" #-} -- | Run CoreRun. -- TBD: fix dependence on whole program linked-cpRunCoreRun :: HsName -> EHCompilePhase ()+cpRunCoreRun :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpRunCoreRun modNm = do cr <- get let (ecu,_,opts,_) = crBaseInfo modNm cr@@ -35,11 +36,12 @@ {-# LINE 72 "src/ehc/EHC/CompilePhase/Run.chs" #-} -- | Run CoreRun. -- 20150130: TBD: does not work yet-cpRunCoreRun2 :: HsName -> EHCompilePhase ()+cpRunCoreRun2 :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpRunCoreRun2 modNm = do cr <- get let (ecu,_,opts,_) = crBaseInfo modNm cr mbCore = ecuMbCore ecu+ let hasMain = ecuHasMain ecu (impModL, mainMod) <- fmap (fromJust . initlast) $ case crPartitionMainAndImported cr $ map head $ crCompileOrder cr of (_, impl) -> do@@ -47,9 +49,29 @@ return $ flip evalState emptyNm2RefMp $ do forM (zip cores [0..]) $ \(cr,modnr) -> do prevNm2Ref <- get- let (m,nm2ref) = cmod2CoreRun' opts modnr prevNm2Ref cr+ let (m,nm2ref,_) = cmod2CoreRun' opts hasMain modnr prevNm2Ref cr put $ nm2refUnion nm2ref prevNm2Ref return m+ cpMsg modNm VerboseNormal "Run Core"+ res <- liftIO $ catch+ (runCoreRun opts impModL mainMod $ cmodRun opts mainMod)+ (\(e :: SomeException) -> hFlush stdout >> (return $ Left $ strMsg $ "cpRunCoreRun: " ++ show e))+ either (\e -> cpSetLimitErrsWhen 1 "Run Core(Run) errors" [e])+ (\_ -> return ())+ res++{-# LINE 109 "src/ehc/EHC/CompilePhase/Run.chs" #-}+-- | Run CoreRun.+cpRunCoreRun3 :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()+cpRunCoreRun3 modNm = do+ cr <- get+ let (ecu,_,opts,_) = crBaseInfo modNm cr+ mbCore = ecuMbCore ecu+ let hasMain = ecuHasMain ecu+ (impModL, mainMod) <- fmap (fromJust . initlast) $+ case crPartitionMainAndImported cr $ map head $ crCompileOrder cr of+ (_, impl) -> do+ forM (impl ++ [modNm]) cpGetPrevCoreRun cpMsg modNm VerboseNormal "Run Core" res <- liftIO $ catch (runCoreRun opts impModL mainMod $ cmodRun opts mainMod)
@@ -1,7 +1,9 @@ module UHC.Light.Compiler.EHC.CompilePhase.Semantics ( cpFoldCore2Grin+, cpFoldCore2CoreRun , cpFoldEH , cpFoldHs+, cpFoldCoreRunMod , cpFoldCoreMod , cpFoldHsMod , cpFoldHIInfo )@@ -15,9 +17,12 @@ import qualified UHC.Light.Compiler.HS.MainAG as HSSem import qualified UHC.Light.Compiler.Core as Core import qualified UHC.Light.Compiler.Core.ToGrin as Core2GrSem+import qualified UHC.Light.Compiler.Core.ToCoreRun as Core2CoreRunSem+import qualified UHC.Light.Compiler.CoreRun as CoreRun import qualified Data.Set as Set import UHC.Light.Compiler.EHC.CompilePhase.Common import qualified UHC.Light.Compiler.Core.Check as Core2ChkSem+import qualified UHC.Light.Compiler.CoreRun.Check as CoreRun2ChkSem import qualified UHC.Light.Compiler.HI as HI import qualified UHC.Util.Rel as Rel import UHC.Light.Compiler.Module.ImportExport@@ -33,8 +38,11 @@ -{-# LINE 63 "src/ehc/EHC/CompilePhase/Semantics.chs" #-}-cpFoldCore2Grin :: HsName -> EHCompilePhase ()++++{-# LINE 70 "src/ehc/EHC/CompilePhase/Semantics.chs" #-}+cpFoldCore2Grin :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpFoldCore2Grin modNm = do { cr <- get ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr@@ -52,8 +60,51 @@ )) } -{-# LINE 85 "src/ehc/EHC/CompilePhase/Semantics.chs" #-}-cpFoldCoreMod :: HsName -> EHCompilePhase ()+{-# LINE 92 "src/ehc/EHC/CompilePhase/Semantics.chs" #-}+cpFoldCore2CoreRun :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()+cpFoldCore2CoreRun modNm+ = do { cr <- get+ ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr+ mbCore = ecuMbCore ecu+ hasMain = ecuHasMain ecu+ core = panicJust "cpFoldCore2CoreRun" mbCore+ core2RunInh = crsiCore2RunInh crsi+ (corerun,nm2ref,sem) = Core2CoreRunSem.cmod2CoreRun' opts hasMain 0 core2RunInh core+ core2RunInh' = nm2ref `CoreRun.nm2refUnion` core2RunInh+ ; when (isJust mbCore) $ do+ -- between module flow part+ cpUpdSI (\crsi -> crsi {crsiCore2RunInh = core2RunInh'})+ -- per module part+ cpUpdCU modNm ( ecuStoreCoreRun corerun+ . ecuStoreCore2CoreRunSem sem+ )+ }++{-# LINE 117 "src/ehc/EHC/CompilePhase/Semantics.chs" #-}+cpFoldCoreRunMod :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()+cpFoldCoreRunMod modNm+ = do { cr <- get+ ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr+ mbCoreRun= ecuMbCoreRun ecu+ core = panicJust "cpFoldCoreRunMod" mbCoreRun+ inh = CoreRun2ChkSem.Inh_AGItf+ { CoreRun2ChkSem.opts_Inh_AGItf = opts+ , CoreRun2ChkSem.moduleNm_Inh_AGItf = modNm+ -- , CoreRun2ChkSem.dataGam_Inh_AGItf = EHSem.dataGam_Inh_AGItf $ crsiEHInh crsi+ }+ crrSem = CoreRun2ChkSem.crmodCheck' inh core+ hasMain = CoreRun2ChkSem.hasMain_Syn_AGItf crrSem+ mod = CoreRun2ChkSem.mod_Syn_AGItf crrSem+ -- ; liftIO $ putStrLn $ "cpFoldCoreRunMod " ++ show hasMain+ ; when (isJust mbCoreRun)+ (cpUpdCU modNm ( ecuStoreCoreRunSemMod crrSem+ . ecuSetHasMain hasMain+ . ecuStoreMod mod+ ))+ }++{-# LINE 141 "src/ehc/EHC/CompilePhase/Semantics.chs" #-}+cpFoldCoreMod :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpFoldCoreMod modNm = do { cr <- get ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr@@ -67,7 +118,7 @@ coreSem = Core2ChkSem.cmodCheck' inh core hasMain = Core2ChkSem.hasMain_Syn_CodeAGItf coreSem mod = Core2ChkSem.mod_Syn_CodeAGItf coreSem- -- ; lift $ putStrLn $ "cpFoldCoreMod " ++ show hasMain+ -- ; liftIO $ putStrLn $ "cpFoldCoreMod " ++ show hasMain ; when (isJust mbCore) (cpUpdCU modNm ( ecuStoreCoreSemMod coreSem . ecuSetHasMain hasMain@@ -75,8 +126,8 @@ )) } -{-# LINE 109 "src/ehc/EHC/CompilePhase/Semantics.chs" #-}-cpFoldEH :: HsName -> EHCompilePhase ()+{-# LINE 165 "src/ehc/EHC/CompilePhase/Semantics.chs" #-}+cpFoldEH :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpFoldEH modNm = do { cr <- get ; mieimpl <- cpGenModuleImportExportImpl modNm@@ -95,8 +146,8 @@ (cpUpdCU modNm $! ecuStoreEHSem $! ehSem) } -{-# LINE 136 "src/ehc/EHC/CompilePhase/Semantics.chs" #-}-cpFoldHs :: HsName -> EHCompilePhase ()+{-# LINE 192 "src/ehc/EHC/CompilePhase/Semantics.chs" #-}+cpFoldHs :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpFoldHs modNm = do { cr <- get ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr@@ -126,13 +177,13 @@ -- . ecuSetHasMain hasMain ) ; when (ehcOptVerbosity opts >= VerboseDebug)- (lift $ putStrLn (show modNm ++ " hasMain=" ++ show hasMain))+ (liftIO $ putStrLn (show modNm ++ " hasMain=" ++ show hasMain)) -- ; when hasMain (crSetAndCheckMain modNm) }) } -{-# LINE 183 "src/ehc/EHC/CompilePhase/Semantics.chs" #-}-cpFoldHsMod :: HsName -> EHCompilePhase ()+{-# LINE 239 "src/ehc/EHC/CompilePhase/Semantics.chs" #-}+cpFoldHsMod :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpFoldHsMod modNm = do { cr <- get ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr@@ -154,8 +205,8 @@ ) ) } -{-# LINE 211 "src/ehc/EHC/CompilePhase/Semantics.chs" #-}-cpFoldHIInfo :: HsName -> EHCompilePhase ()+{-# LINE 267 "src/ehc/EHC/CompilePhase/Semantics.chs" #-}+cpFoldHIInfo :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpFoldHIInfo modNm = do { cr <- get ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr@@ -178,7 +229,7 @@ . ecuSetHasMain hasMain ) ; when (ehcOptVerbosity opts >= VerboseDebug)- (lift $ putStrLn+ (liftIO $ putStrLn (show modNm ++ ": hi imps, decl=" ++ show (HI.hiiHIDeclImpModS hiInfo) ++ ", used=" ++ show (HI.hiiHIUsedImpModS hiInfo)
@@ -30,6 +30,7 @@ import qualified UHC.Light.Compiler.Core as Core (cModMergeByConcat) import qualified UHC.Light.Compiler.Core.Merge as CMerge (cModMerge) import qualified UHC.Light.Compiler.Core.Check as Core2ChkSem+import qualified UHC.Light.Compiler.CoreRun.Check as CoreRun2ChkSem import UHC.Light.Compiler.Base.PackageDatabase import UHC.Light.Compiler.EHC.CompilePhase.Link import UHC.Light.Compiler.Base.Pragma@@ -66,9 +67,10 @@ -{-# LINE 112 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}++{-# LINE 114 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} -- | top lever driver for after all per-module work has been done, and whole program stuff like combining/linking can start-cpEhcFullProgLinkAllModules :: [HsName] -> EHCompilePhase ()+cpEhcFullProgLinkAllModules :: EHCCompileRunner m => [HsName] -> EHCompilePhaseT m () cpEhcFullProgLinkAllModules modNmL = do { cr <- get ; let (mainModNmL,impModNmL) = crPartitionMainAndImported cr modNmL@@ -111,8 +113,8 @@ _ -> return () } -{-# LINE 169 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}-cpEhcCheckAbsenceOfMutRecModules :: EHCompilePhase ()+{-# LINE 171 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+cpEhcCheckAbsenceOfMutRecModules :: EHCCompileRunner m => EHCompilePhaseT m () cpEhcCheckAbsenceOfMutRecModules = do { cr <- get ; let mutRecL = filter (\ml -> length ml > 1) $ crCompileOrder cr@@ -121,8 +123,8 @@ ) } -{-# LINE 192 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}-cpEhcFullProgCompileAllModules :: EHCompilePhase ()+{-# LINE 194 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+cpEhcFullProgCompileAllModules :: EHCCompileRunner m => EHCompilePhaseT m () cpEhcFullProgCompileAllModules = do { cr <- get ; let modNmLL = crCompileOrder cr@@ -137,14 +139,14 @@ ) } -{-# LINE 224 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}-cpEhcFullProgPostModulePhases :: EHCOpts -> [HsName] -> ([HsName],HsName) -> EHCompilePhase ()+{-# LINE 226 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+cpEhcFullProgPostModulePhases :: EHCCompileRunner m => EHCOpts -> [HsName] -> ([HsName],HsName) -> EHCompilePhaseT m () cpEhcFullProgPostModulePhases opts modNmL modSpl | ehcOptOptimizationScope opts >= OptimizationScope_WholeCore = cpEhcCoreFullProgPostModulePhases opts modNmL modSpl | otherwise = return () -{-# LINE 266 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}-cpEhcCoreFullProgPostModulePhases :: EHCOpts -> [HsName] -> ([HsName],HsName) -> EHCompilePhase ()+{-# LINE 268 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+cpEhcCoreFullProgPostModulePhases :: EHCCompileRunner m => EHCOpts -> [HsName] -> ([HsName],HsName) -> EHCompilePhaseT m () cpEhcCoreFullProgPostModulePhases opts modNmL (impModNmL,mainModNm) = cpSeq ([ cpSeq [void $ cpGetPrevCore m | m <- modNmL] , mergeIntoOneBigCore@@ -165,13 +167,13 @@ } where mOf m cr = panicJust "cpEhcCoreFullProgPostModulePhases.mergeIntoOneBigCore" $ ecuMbCore $ crCU m cr -{-# LINE 291 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+{-# LINE 293 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} {-| Per module compilation of (import) ordered sequence of module, as part of a full program compilation -}-{-# LINE 295 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}-cpEhcFullProgModuleCompileN :: [HsName] -> EHCompilePhase ()+{-# LINE 297 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+cpEhcFullProgModuleCompileN :: EHCCompileRunner m => [HsName] -> EHCompilePhaseT m () cpEhcFullProgModuleCompileN modNmL = cpSeq (merge (map cpEhcFullProgModuleCompile1 modNmL) (map cpEhcFullProgBetweenModuleFlow modNmL)@@ -180,20 +182,20 @@ merge [] cs = cs merge cs [] = cs -{-# LINE 306 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+{-# LINE 308 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} {-| Find out whether a compilation is needed, and if so, can be done. -}-{-# LINE 310 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}-cpEhcFullProgModuleDetermineNeedsCompile :: HsName -> EHCompilePhase ()+{-# LINE 312 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+cpEhcFullProgModuleDetermineNeedsCompile :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpEhcFullProgModuleDetermineNeedsCompile modNm = do { cr <- get ; let (ecu,_,opts,_) = crBaseInfo modNm cr needsCompile = crModNeedsCompile modNm cr canCompile = crModCanCompile modNm cr ; when (ehcOptVerbosity opts >= VerboseDebug)- (lift $ putStrLn+ (liftIO $ putStrLn ( show modNm ++ ", src fpath: " ++ show (ecuSrcFilePath ecu) ++ ", fileloc: " ++ show (ecuFileLocation ecu)@@ -209,18 +211,18 @@ ; cpUpdCU modNm (ecuSetNeedsCompile (needsCompile && canCompile)) } -{-# LINE 335 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+{-# LINE 337 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} {-| Compilation of 1 module, as part of a full program compilation -}-{-# LINE 339 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}-cpEhcFullProgModuleCompile1 :: HsName -> EHCompilePhase ()+{-# LINE 341 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+cpEhcFullProgModuleCompile1 :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpEhcFullProgModuleCompile1 modNm = do { cr <- get ; let (_,opts) = crBaseInfo' cr -- ' ; when (ehcOptVerbosity opts >= VerboseALot)- (lift $ putStrLn ("====================== Compile1: " ++ show modNm ++ "======================"))+ (liftIO $ putStrLn ("====================== Compile1: " ++ show modNm ++ "======================")) ; cpEhcFullProgModuleDetermineNeedsCompile modNm ; cr <- get ; let (ecu,_,_,_) = crBaseInfo modNm cr@@ -232,13 +234,13 @@ ; when (ecuHasMain ecu) (crSetAndCheckMain modNm) } -{-# LINE 358 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+{-# LINE 360 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} {-| Flow of info between modules, as part of a full program compilation -}-{-# LINE 362 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}-cpEhcFullProgBetweenModuleFlow :: HsName -> EHCompilePhase ()+{-# LINE 364 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+cpEhcFullProgBetweenModuleFlow :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpEhcFullProgBetweenModuleFlow modNm = do { cr <- get ; case ecuState $ crCU modNm cr of@@ -248,19 +250,19 @@ ; cpCleanupFlow modNm } -{-# LINE 384 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}-cpEhcModuleCompile1 :: Maybe EHCompileUnitState -> HsName -> EHCompilePhase HsName+{-# LINE 386 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+cpEhcModuleCompile1 :: EHCCompileRunner m => Maybe EHCompileUnitState -> HsName -> EHCompilePhaseT m HsName cpEhcModuleCompile1 targHSState modNm-{-# LINE 388 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+{-# LINE 390 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} = do { cr <- get ; let (ecu,_,opts,fp) = crBaseInfo modNm cr defaultResult = modNm ; when (ehcOptVerbosity opts >= VerboseALot)- (lift $ putStrLn ("====================== Module: " ++ show modNm ++ " ======================"))+ (liftIO $ putStrLn ("====================== Module: " ++ show modNm ++ " ======================")) ; when (ehcOptVerbosity opts >= VerboseDebug)- (lift $ putStrLn ("State: in: " ++ show (ecuState ecu) ++ ", to: " ++ show targHSState))+ (liftIO $ putStrLn ("State: in: " ++ show (ecuState ecu) ++ ", to: " ++ show targHSState)) ; case (ecuState ecu,targHSState) of-{-# LINE 416 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+{-# LINE 418 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} (ECUS_Haskell st,Just (ECUS_Haskell HSOnlyImports)) | st == HSStart || st == LHSStart@@ -273,7 +275,7 @@ ; when (ehcOptVerbosity opts >= VerboseDebug) (do { cr <- get ; let (ecu,_,opts,fp) = crBaseInfo modNm2 cr- ; lift $ putStrLn ("After HS import: nm=" ++ show modNm ++ ", newnm=" ++ show modNm2 ++ ", fp=" ++ show fp ++ ", imp=" ++ show (ecuImpNmS ecu))+ ; liftIO $ putStrLn ("After HS import: nm=" ++ show modNm ++ ", newnm=" ++ show modNm2 ++ ", fp=" ++ show fp ++ ", imp=" ++ show (ecuImpNmS ecu)) }) ; cpUpdCU modNm2 (ecuStoreState (ECUS_Haskell stnext)) ; cpStopAt CompilePoint_Imports@@ -287,7 +289,7 @@ ; when (ehcOptVerbosity opts >= VerboseDebug) (do { cr <- get ; let (ecu,_,opts,fp) = crBaseInfo modNm cr- ; lift $ putStrLn ("After HI import: nm=" ++ show modNm ++ ", fp=" ++ show fp ++ ", imp=" ++ show (ecuImpNmS ecu))+ ; liftIO $ putStrLn ("After HI import: nm=" ++ show modNm ++ ", fp=" ++ show fp ++ ", imp=" ++ show (ecuImpNmS ecu)) }) ; return defaultResult }@@ -315,7 +317,7 @@ ; return defaultResult } -{-# LINE 487 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+{-# LINE 489 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} (ECUS_Haskell HSStart,_) -> do { cpMsg modNm VerboseMinimal "Compiling Haskell" ; cpEhcHaskellModulePrepare modNm@@ -337,27 +339,33 @@ ; cpUpdCU modNm (ecuStoreState (ECUS_Haskell HMOnlyMinimal)) ; return defaultResult }+ (ECUS_CoreRun cst, Just (ECUS_Haskell HSOnlyImports))+ | {- cst == CRRStartText || -} isBinary+ -> do { cpMsg modNm VerboseNormal $ "Reading CoreRun (" ++ (if isBinary then "binary" else "textual") ++ ")"+ ; cpEhcHaskellModulePrepareSrc modNm+ ; modNm2 <- cpEhcCoreRunImport isBinary modNm+ ; cpUpdCU modNm2 (ecuStoreState (ECUS_CoreRun CRROnlyImports))+ ; return modNm2+ }+ where isBinary = cst == CRRStartBinary+ (ECUS_CoreRun CRROnlyImports,Just (ECUS_CoreRun CRRAllSem))+ -> do { cpMsg modNm VerboseMinimal "Compiling CoreRun"+ ; cpEhcCoreRunModuleAfterImport (ecuIsTopMod ecu) opts modNm+ ; cpUpdCU modNm (ecuStoreState (ECUS_CoreRun CRRAllSem))+ ; return defaultResult+ } (ECUS_Core cst, Just (ECUS_Haskell HSOnlyImports)) | cst == CRStartText || isBinary -> do { cpMsg modNm VerboseNormal $ "Reading Core (" ++ (if isBinary then "binary" else "textual") ++ ")"- -- 20140605 AD, code below is temporary, to cater for minimal and working infrastructure first...- -- ; cpGetDummyCheckSrcMod modNm -- really dummy, should be based on actual import info to be extracted by cpEhcCoreImport ; cpEhcHaskellModulePrepareSrc modNm ; modNm2 <- cpEhcCoreImport isBinary modNm- -- ; cpGetDummyCheckSrcMod modNm2 -- really dummy, should be based on actual import info to be extracted by cpEhcCoreImport- -- ; cpCheckModsWithBuiltin [modNm2] ; cpUpdCU modNm2 (ecuStoreState (ECUS_Core CROnlyImports)) ; return modNm2 } where isBinary = cst == CRStartBinary (ECUS_Core CROnlyImports,Just (ECUS_Core CRAllSem)) -> do { cpMsg modNm VerboseMinimal "Compiling Core"- -- 20140605 AD, code below is temporary, to cater for minimal and working infrastructure first... ; cpEhcCoreModuleAfterImport (ecuIsTopMod ecu) opts modNm-{-- ; cpProcessCoreModFold modNm- ; cpEhcCoreModuleCommonPhases True True True {- isMainMod isTopMod doMkExec -} opts modNm--} ; cpUpdCU modNm (ecuStoreState (ECUS_Core CRAllSem)) ; return defaultResult }@@ -402,30 +410,30 @@ _ -> return defaultResult } -{-# LINE 608 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+{-# LINE 618 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} {-| EH common phases: analysis + core + grin -}-{-# LINE 612 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}-cpEhcCoreModuleCommonPhases :: Bool -> Bool -> Bool -> EHCOpts -> HsName -> EHCompilePhase ()+{-# LINE 622 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+cpEhcCoreModuleCommonPhases :: EHCCompileRunner m => Bool -> Bool -> Bool -> EHCOpts -> HsName -> EHCompilePhaseT m () cpEhcCoreModuleCommonPhases isMainMod isTopMod doMkExec opts modNm = cpSeq ([ cpEhcCorePerModulePart1 modNm ] ) -{-# LINE 629 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}-cpEhcEhModuleCommonPhases :: Bool -> Bool -> Bool -> EHCOpts -> HsName -> EHCompilePhase ()+{-# LINE 639 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+cpEhcEhModuleCommonPhases :: EHCCompileRunner m => Bool -> Bool -> Bool -> EHCOpts -> HsName -> EHCompilePhaseT m () cpEhcEhModuleCommonPhases isMainMod isTopMod doMkExec opts modNm = cpSeq [ cpEhcEhAnalyseModuleDefs modNm , cpEhcCoreModuleCommonPhases isMainMod isTopMod doMkExec opts modNm ] -{-# LINE 637 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+{-# LINE 647 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} -- | Common phases when starting with a Haskell module. -- HS common phases: HS analysis + EH common-cpEhcHaskellModuleCommonPhases :: Bool -> Bool -> EHCOpts -> HsName -> EHCompilePhase ()+cpEhcHaskellModuleCommonPhases :: EHCCompileRunner m => Bool -> Bool -> EHCOpts -> HsName -> EHCompilePhaseT m () cpEhcHaskellModuleCommonPhases isTopMod doMkExec opts modNm = cpSeq [ cpEhcHaskellAnalyseModuleDefs modNm , do { cr <- get@@ -436,13 +444,14 @@ } ] -{-# LINE 656 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+{-# LINE 666 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} -- | All the work to be done after Haskell src imports have been read/analysed. -- Post module import common phases: Parse + Module analysis + HS common cpEhcHaskellModuleAfterImport- :: Bool -> EHCOpts -> HSState+ :: EHCCompileRunner m =>+ Bool -> EHCOpts -> HSState -> [PkgModulePartition]- -> HsName -> EHCompilePhase ()+ -> HsName -> EHCompilePhaseT m () cpEhcHaskellModuleAfterImport isTopMod opts hsst pkgKeyDirL@@ -455,11 +464,12 @@ , cpEhcHaskellModulePostlude modNm ] -{-# LINE 682 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+{-# LINE 693 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} -- | All the work to be done after Core src/binary imports have been read/analysed cpEhcCoreModuleAfterImport- :: Bool -> EHCOpts- -> HsName -> EHCompilePhase ()+ :: EHCCompileRunner m =>+ Bool -> EHCOpts+ -> HsName -> EHCompilePhaseT m () cpEhcCoreModuleAfterImport isTopMod opts modNm@@ -469,28 +479,43 @@ [ cpEhcCoreAnalyseModuleItf modNm , cpProcessCoreModFold modNm , cpEhcCoreModuleCommonPhases (ecuIsMainMod ecu) isTopMod False opts modNm-{-- , cpEhcHaskellModuleCommonPhases isTopMod False opts modNm- , cpEhcHaskellModulePostlude modNm--} ] } -{-# LINE 708 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+{-# LINE 712 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+-- | All the work to be done after CoreRun src/binary imports have been read/analysed+cpEhcCoreRunModuleAfterImport+ :: EHCCompileRunner m =>+ Bool -> EHCOpts+ -> HsName -> EHCompilePhaseT m ()+cpEhcCoreRunModuleAfterImport+ isTopMod opts+ modNm+ = do { cr <- get+ ; let (ecu,_,_,_) = crBaseInfo modNm cr+ ; cpSeq+ [ cpEhcCoreRunAnalyseModuleItf modNm+ , cpProcessCoreRunModFold modNm+ -- , cpEhcCoreRunModuleCommonPhases (ecuIsMainMod ecu) isTopMod False opts modNm+ ]+ }++{-# LINE 735 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} {-| Prepare module for compilation. This should be the first step before compilation of a module and is meant to obtain cached info from a previous compilation. -}-{-# LINE 725 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}-cpEhcHaskellModulePrepareSrc :: HsName -> EHCompilePhase ()+{-# LINE 752 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+cpEhcHaskellModulePrepareSrc :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpEhcHaskellModulePrepareSrc modNm = cpGetMetaInfo [GetMeta_Src,GetMeta_Dir] modNm -cpEhcHaskellModulePrepareHS2 :: HsName -> EHCompilePhase ()+cpEhcHaskellModulePrepareHS2 :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpEhcHaskellModulePrepareHS2 modNm = cpSeq [ cpGetMetaInfo [ GetMeta_Src, GetMeta_HI, GetMeta_Core+ , GetMeta_CoreRun , GetMeta_Dir ] modNm , cpGetPrevHI modNm@@ -498,35 +523,37 @@ , cpFoldHIInfo modNm ] -cpEhcHaskellModulePrepareHI :: HsName -> EHCompilePhase ()+cpEhcHaskellModulePrepareHI :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpEhcHaskellModulePrepareHI modNm = cpSeq [ cpGetMetaInfo [ GetMeta_HI, GetMeta_Core+ , GetMeta_CoreRun ] modNm , cpGetPrevHI modNm -- , cpFoldHI modNm , cpFoldHIInfo modNm ] -cpEhcHaskellModulePrepare :: HsName -> EHCompilePhase ()+cpEhcHaskellModulePrepare :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpEhcHaskellModulePrepare modNm = cpSeq [ cpEhcHaskellModulePrepareSrc modNm , cpEhcHaskellModulePrepareHS2 modNm ] -{-# LINE 764 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}-cpEhcHaskellModulePostlude :: HsName -> EHCompilePhase ()+{-# LINE 797 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+cpEhcHaskellModulePostlude :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpEhcHaskellModulePostlude modNm = cpSeq [ cpOutputHI "hi" modNm , cpCleanupCU modNm ] -{-# LINE 774 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+{-# LINE 807 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} -- | Get import information from Haskell module source text. cpEhcHaskellImport- :: HSState+ :: EHCCompileRunner m =>+ HSState -> [PkgModulePartition]- -> HsName -> EHCompilePhase HsName+ -> HsName -> EHCompilePhaseT m HsName cpEhcHaskellImport hsst pkgKeyDirL@@ -570,12 +597,13 @@ ; cpGetHsModnameAndImports modNm } -{-# LINE 839 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+{-# LINE 873 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} -- | Parse a Haskell module cpEhcHaskellParse- :: Bool -> Bool+ :: EHCCompileRunner m =>+ Bool -> Bool -> [PkgModulePartition]- -> HsName -> EHCompilePhase ()+ -> HsName -> EHCompilePhaseT m () cpEhcHaskellParse doCPP litmode pkgKeyDirL@@ -588,44 +616,56 @@ ] ) -{-# LINE 866 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}-cpEhcEhParse :: HsName -> EHCompilePhase ()+{-# LINE 901 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+cpEhcEhParse :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpEhcEhParse modNm = cpSeq [ cpParseEH modNm , cpStopAt CompilePoint_Parse ] -{-# LINE 874 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}-cpEhcCoreParse :: HsName -> EHCompilePhase ()+{-# LINE 909 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+cpEhcCoreParse :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpEhcCoreParse modNm = cpSeq [ cpParseCoreWithFPath Nothing modNm , cpStopAt CompilePoint_Parse ] -{-# LINE 882 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+{-# LINE 917 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} -- | Analyse a Haskell src module for -- (1) module information (import, export, etc),-cpEhcHaskellAnalyseModuleItf :: HsName -> EHCompilePhase ()+cpEhcHaskellAnalyseModuleItf :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpEhcHaskellAnalyseModuleItf modNm = cpSeq [ cpStepUID, cpFoldHsMod modNm, cpGetHsMod modNm , cpCheckModsWithBuiltin [modNm] , cpCleanupHSMod modNm ] -{-# LINE 898 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+{-# LINE 933 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} -- | Analyse a Core text/binary src module for--- (1) module information (import, export, etc),-cpEhcCoreAnalyseModuleItf :: HsName -> EHCompilePhase ()+-- (1) module information (import, export, etc).+-- Note: TBD: identical to cpEhcCoreRunAnalyseModuleItf+cpEhcCoreAnalyseModuleItf :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpEhcCoreAnalyseModuleItf modNm = cpSeq [ cpMsg modNm VerboseDebug "cpEhcCoreAnalyseModuleItf" , cpCheckModsWithoutBuiltin [modNm] -- , cpCleanupHSMod modNm ] -{-# LINE 914 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+{-# LINE 950 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+-- | Analyse a CoreRun text/binary src module for+-- (1) module information (import, export, etc).+-- Note: TBD: identical to cpEhcCoreAnalyseModuleItf+cpEhcCoreRunAnalyseModuleItf :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()+cpEhcCoreRunAnalyseModuleItf modNm+ = cpSeq [ cpMsg modNm VerboseDebug "cpEhcCoreRunAnalyseModuleItf"+ , cpCheckModsWithoutBuiltin [modNm]+ -- , cpCleanupHSMod modNm+ ]++{-# LINE 967 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} -- | Analyse a Haskell src module for -- (2) names + dependencies-cpEhcHaskellAnalyseModuleDefs :: HsName -> EHCompilePhase ()+cpEhcHaskellAnalyseModuleDefs :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpEhcHaskellAnalyseModuleDefs modNm = cpSeq [ cpStepUID , cpProcessHs modNm@@ -633,19 +673,19 @@ , cpStopAt CompilePoint_AnalHS ] -{-# LINE 926 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+{-# LINE 979 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} -- | Analyse a Haskell src module for -- (3) types-cpEhcEhAnalyseModuleDefs :: HsName -> EHCompilePhase ()+cpEhcEhAnalyseModuleDefs :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpEhcEhAnalyseModuleDefs modNm = cpSeq [ cpStepUID, cpProcessEH modNm , cpMsg modNm VerboseALot "Type analysis done" , cpStopAt CompilePoint_AnalEH ] -{-# LINE 937 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+{-# LINE 990 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} -- | Part 1 Core processing, on a per module basis, part1 is done always-cpEhcCorePerModulePart1 :: HsName -> EHCompilePhase ()+cpEhcCorePerModulePart1 :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpEhcCorePerModulePart1 modNm = do { cr <- get ; let (_,_,opts,_) = crBaseInfo modNm cr@@ -660,26 +700,41 @@ ) } -{-# LINE 969 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}--- | Get import information from Core module source text.+{-# LINE 1022 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+-- | Get import information from Core module source text/binary. cpEhcCoreImport- :: Bool -> HsName -> EHCompilePhase HsName+ :: EHCCompileRunner m => Bool -> HsName -> EHCompilePhaseT m HsName cpEhcCoreImport isBinary modNm = do { cr <- get ; let (_,opts) = crBaseInfo' cr ; if isBinary- then -- cpDecodeCore (Just Cfg.suffixDotlessInputOutputBinaryCore) modNm- cpDecodeCore Nothing modNm+ then cpDecodeCore Nothing modNm else cpParseCoreWithFPath Nothing modNm ; cpFoldCoreMod modNm ; cpGetCoreModnameAndImports modNm } -{-# LINE 987 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+{-# LINE 1039 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+-- | Get import information from CoreRun module source text/binary.+cpEhcCoreRunImport+ :: EHCCompileRunner m => Bool -> HsName -> EHCompilePhaseT m HsName+cpEhcCoreRunImport+ isBinary modNm+ = do { cr <- get+ ; let (_,opts) = crBaseInfo' cr++ ; {- if isBinary+ then -} cpDecodeCoreRun Nothing modNm+ {- else cpParseCoreWithFPath Nothing modNm -}+ ; cpFoldCoreRunMod modNm+ ; cpGetCoreRunModnameAndImports modNm+ }++{-# LINE 1056 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} -- | Analyse a Core src module-cpEhcCoreAnalyseModule :: HsName -> EHCompilePhase ()+cpEhcCoreAnalyseModule :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpEhcCoreAnalyseModule modNm = do { cr <- get ; cpUpdateModOffMp [modNm]@@ -689,9 +744,21 @@ ; cpSetLimitErrsWhen 5 "Core analysis" errs } -{-# LINE 1000 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+{-# LINE 1069 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+-- | Analyse a CoreRun src module+cpEhcCoreRunAnalyseModule :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()+cpEhcCoreRunAnalyseModule modNm+ = do { cr <- get+ ; cpUpdateModOffMp [modNm]+ ; let (ecu,_,opts,_) = crBaseInfo modNm cr+ corerunSem = panicJust "cpEhcCoreRunAnalyseModule" $ ecuMbCoreRunSemMod ecu+ errs = [] -- No errors -- Seq.toList $ CoreRun2ChkSem.errs_Syn_AGItf corerunSem+ ; cpSetLimitErrsWhen 5 "CoreRun analysis" errs+ }++{-# LINE 1082 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} -- | Part 2 Core processing, part2 is done either for per individual module compilation or after full program analysis-cpEhcCorePerModulePart2 :: HsName -> EHCompilePhase ()+cpEhcCorePerModulePart2 :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpEhcCorePerModulePart2 modNm = do { cr <- get ; let (_,_,opts,_) = crBaseInfo modNm cr@@ -700,9 +767,14 @@ ] } -{-# LINE 1044 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+{-# LINE 1101 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+-- | Part 2 CoreRun processing, part2 is done either for per individual module compilation or after full program analysis+cpEhcCoreRunPerModulePart2 :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()+cpEhcCoreRunPerModulePart2 = cpProcessCoreRunRest++{-# LINE 1132 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} -- | Core+grin processing, on a per module basis, may only be done when full program analysis is done-cpEhcCoreGrinPerModuleDoneFullProgAnalysis :: HsName -> EHCompilePhase ()+cpEhcCoreGrinPerModuleDoneFullProgAnalysis :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpEhcCoreGrinPerModuleDoneFullProgAnalysis modNm = cpSeq ( [ cpEhcCorePerModulePart2 modNm , cpEhcExecutablePerModule FinalCompile_Exec [] modNm@@ -710,9 +782,9 @@ ] ) -{-# LINE 1055 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+{-# LINE 1143 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} -- | Make final executable code, either still partly or fully (i.e. also linking)-cpEhcExecutablePerModule :: FinalCompileHow -> [HsName] -> HsName -> EHCompilePhase ()+cpEhcExecutablePerModule :: EHCCompileRunner m => FinalCompileHow -> [HsName] -> HsName -> EHCompilePhaseT m () cpEhcExecutablePerModule how impModNmL modNm = do { cr <- get ; let (_,_,opts,_) = crBaseInfo modNm cr@@ -720,8 +792,8 @@ [ cpCompileWithGCC how impModNmL modNm ] } -{-# LINE 1081 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}-cpProcessHs :: HsName -> EHCompilePhase ()+{-# LINE 1169 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+cpProcessHs :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpProcessHs modNm = cpSeq [ cpFoldHs modNm , cpFlowHsSem1 modNm@@ -729,8 +801,8 @@ , cpCleanupHS modNm ] -{-# LINE 1095 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}-cpProcessEH :: HsName -> EHCompilePhase ()+{-# LINE 1183 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+cpProcessEH :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpProcessEH modNm = do { cr <- get ; let (_,_,opts,fp) = crBaseInfo modNm cr@@ -756,40 +828,55 @@ ] } -{-# LINE 1157 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+{-# LINE 1245 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} -- unprocessed core -> folded core-cpProcessCoreBasic :: HsName -> EHCompilePhase ()+cpProcessCoreBasic :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpProcessCoreBasic modNm = do { cr <- get ; let (_,_,opts,_) = crBaseInfo modNm cr ; cpSeq [ cpTransformCore OptimizationScope_PerModule modNm , cpFlowHILamMp modNm- , void $ cpOutputCore CPOutputCoreHow_Binary [] "" Cfg.suffixDotlessBinaryCore modNm+ , void $ cpOutputCore CPOutputCoreHow_Binary [] "" Cfg.suffixDotlessBinaryCore modNm , cpProcessCoreFold modNm+ , when (targetIsCoreVariation (ehcOptTarget opts)) $+ void $ cpOutputCoreRun CPOutputCoreRunHow_Binary "" Cfg.suffixDotlessBinaryCoreRun modNm ] } -{-# LINE 1173 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+{-# LINE 1265 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} -- unfolded core -> folded core -- (called on merged core, and on core directly generated from cached grin)-cpProcessCoreFold :: HsName -> EHCompilePhase ()+cpProcessCoreFold :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpProcessCoreFold modNm- = cpSeq $- [ cpFlowCoreSemBeforeFold modNm ] ++- [ cpFoldCore2Grin modNm ]- ++ [ cpFlowCoreSemAfterFold modNm ]+ = do { cr <- get+ ; let (_,_,opts,_) = crBaseInfo modNm cr+ ; cpSeq $ [] +++ [ cpFlowCoreSemBeforeFold modNm ] +++ (if targetIsViaGrin (ehcOptTarget opts) then [ cpFoldCore2Grin modNm ] else []) +++ (if targetIsCoreVariation (ehcOptTarget opts) then [ cpFoldCore2CoreRun modNm ] else []) +++ [ cpFlowCoreSemAfterFold modNm ] +++ []+ } -{-# LINE 1188 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}-cpProcessCoreModFold :: HsName -> EHCompilePhase ()+{-# LINE 1287 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+cpProcessCoreModFold :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpProcessCoreModFold modNm = cpSeq $ [ cpEhcCoreAnalyseModule modNm , cpFlowCoreModSem modNm ] -{-# LINE 1197 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+{-# LINE 1296 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+cpProcessCoreRunModFold :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()+cpProcessCoreRunModFold modNm+ = cpSeq $+ [ cpEhcCoreRunAnalyseModule modNm+ -- , cpFlowCoreRunModSem modNm+ ]++{-# LINE 1305 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} -- folded core -> grin, jazy, and the rest-cpProcessCoreRest :: HsName -> EHCompilePhase ()+cpProcessCoreRest :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpProcessCoreRest modNm = do { cr <- get ; let (_,_,opts,_) = crBaseInfo modNm cr@@ -800,13 +887,27 @@ ++ (if CoreOpt_DumpBinary `elem` ehcOptCoreOpts opts then [void $ cpOutputCore CPOutputCoreHow_Binary [] "" Cfg.suffixDotlessInputOutputBinaryCore modNm] else [])+ ++ [ cpProcessCoreRunRest modNm ]+ ++ [ cpCleanupCore [modNm] ]+ )+ }+++{-# LINE 1343 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}+-- | folded corerun -> ...+cpProcessCoreRunRest :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()+cpProcessCoreRunRest modNm+ = do { cr <- get+ ; let (_,_,opts,_) = crBaseInfo modNm cr+ ; cpSeq ( [] ++ (if CoreOpt_RunDump `elem` ehcOptCoreOpts opts- then [void $ cpOutputCore CPOutputCoreHow_Run [] "" Cfg.suffixDotlessInputOutputCoreRun modNm]+ then [void $ cpOutputCore CPOutputCoreHow_CoreRun_Text [] "" Cfg.suffixDotlessInputOutputCoreRun modNm] else []) ++ (if CoreOpt_Run `elem` ehcOptCoreOpts opts -- TBD: only when right backend? For now, just do it- then [cpRunCoreRun{-2-} modNm]+ then [cpRunCoreRun modNm]+ -- [cpRunCoreRun2 modNm]+ -- [cpRunCoreRun3 modNm] else [])- ++ [ cpCleanupCore [modNm] ] ) }
@@ -27,7 +27,7 @@ {-# LINE 71 "src/ehc/EHC/CompilePhase/Transformations.chs" #-}-cpTransformCore :: OptimizationScope -> HsName -> EHCompilePhase ()+cpTransformCore :: EHCCompileRunner m => OptimizationScope -> HsName -> EHCompilePhaseT m () cpTransformCore optimScope modNm = do { cr <- get ; let (ecu,crsi,opts,fp) = crBaseInfo modNm cr@@ -50,7 +50,7 @@ } trfcoreOut = trfCore opts optimScope (Core2GrSem.dataGam_Inh_CodeAGItf $ crsiCoreInh crsi) modNm trfcoreIn - -- ; lift $ putStrLn $ "cpTransformCore trfcoreNotYetTransformed: " ++ show (trfcoreNotYetTransformed $ trfstExtra trfcoreIn)+ -- ; liftIO $ putStrLn $ "cpTransformCore trfcoreNotYetTransformed: " ++ show (trfcoreNotYetTransformed $ trfstExtra trfcoreIn) -- put back result: Core ; cpUpdCU modNm $! ecuStoreCore (trfstMod trfcoreOut)
@@ -31,7 +31,7 @@ {-# LINE 97 "src/ehc/EHC/CompilePhase/Translations.chs" #-}-cpTranslateHs2EH :: HsName -> EHCompilePhase ()+cpTranslateHs2EH :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpTranslateHs2EH modNm = do { cr <- get ; let (ecu,crsi,opts,fp) = crBaseInfo modNm cr@@ -43,14 +43,14 @@ (do { cpUpdCU modNm (ecuStoreEH eh) ; cpSetLimitErrsWhen 5 "Dependency/name analysis" errs ; when (ehcOptEmitHS opts)- (lift $ putPPFPath (mkOutputFPath opts modNm fp "hs2") (HSSem.pp_Syn_AGItf hsSem) 1000)+ (liftIO $ putPPFPath (mkOutputFPath opts modNm fp "hs2") (HSSem.pp_Syn_AGItf hsSem) 1000) ; when (ehcOptShowHS opts)- (lift $ putWidthPPLn 120 (HSSem.pp_Syn_AGItf hsSem))+ (liftIO $ putWidthPPLn 120 (HSSem.pp_Syn_AGItf hsSem)) }) } {-# LINE 117 "src/ehc/EHC/CompilePhase/Translations.chs" #-}-cpTranslateEH2Output :: HsName -> EHCompilePhase ()+cpTranslateEH2Output :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpTranslateEH2Output modNm = do { cr <- get ; let (ecu,crsi,opts,fp) = crBaseInfo modNm cr@@ -61,15 +61,15 @@ ; when (isJust mbEHSem) (do { cpSetLimitErrsWhen 5 about errs ; when (ehcOptEmitEH opts)- (lift $ putPPFPath (mkOutputFPath opts modNm fp "eh2") (EHSem.pp_Syn_AGItf ehSem) 1000)+ (liftIO $ putPPFPath (mkOutputFPath opts modNm fp "eh2") (EHSem.pp_Syn_AGItf ehSem) 1000) ; when (ehcOptShowEH opts)- (lift $ putWidthPPLn 120 (EHSem.pp_Syn_AGItf ehSem))+ (liftIO $ putWidthPPLn 120 (EHSem.pp_Syn_AGItf ehSem)) } ) } {-# LINE 162 "src/ehc/EHC/CompilePhase/Translations.chs" #-}-cpTranslateEH2Core :: HsName -> EHCompilePhase ()+cpTranslateEH2Core :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpTranslateEH2Core modNm = do { cr <- get ; let (ecu,crsi,opts,fp) = crBaseInfo modNm cr
@@ -1,7 +1,8 @@ module UHC.Light.Compiler.EHC.CompileRun ( EHCompileRunStateInfo (..) , emptyEHCompileRunStateInfo-, EHCompileRun, EHCompilePhase+, EHCCompileRunner+, EHCompileRun, EHCompilePhaseT, EHCompilePhase , crBaseInfo, crMbBaseInfo, crBaseInfo' , cpUpdOpts , cpMsg, cpMsg'@@ -27,10 +28,13 @@ import System.Environment import System.Process import Control.Monad.State+import Control.Monad.Error+import Control.Exception as CE import UHC.Light.Compiler.CodeGen.ValAccess as VA import UHC.Light.Compiler.EHC.Common import UHC.Light.Compiler.EHC.CompileUnit import qualified UHC.Light.Compiler.Core as Core+import qualified UHC.Light.Compiler.CoreRun as CoreRun import qualified UHC.Light.Compiler.EH.MainAG as EHSem import qualified UHC.Light.Compiler.HS.MainAG as HSSem import qualified UHC.Light.Compiler.Core.ToGrin as Core2GrSem@@ -43,7 +47,6 @@ import Data.IORef import System.IO.Unsafe import System.Directory-import Control.Exception as CE import UHC.Util.FPath import UHC.Light.Compiler.Base.PackageDatabase @@ -58,7 +61,8 @@ -{-# LINE 68 "src/ehc/EHC/CompileRun.chs" #-}++{-# LINE 71 "src/ehc/EHC/CompileRun.chs" #-} type EHCTime = Integer type EHCTimeDiff = Integer @@ -77,7 +81,7 @@ (days, hrs ) = r2 `quotRem` 24 fm n x = strPadLeft '0' n (show x) -{-# LINE 88 "src/ehc/EHC/CompileRun.chs" #-}+{-# LINE 91 "src/ehc/EHC/CompileRun.chs" #-} data EHCIOInfo = EHCIOInfo { ehcioinfoStartTime :: EHCTime@@ -90,7 +94,7 @@ newIORef (EHCIOInfo t t) -{-# LINE 122 "src/ehc/EHC/CompileRun.chs" #-}+{-# LINE 125 "src/ehc/EHC/CompileRun.chs" #-} data EHCompileRunStateInfo = EHCompileRunStateInfo { crsiOpts :: !EHCOpts -- options@@ -99,6 +103,7 @@ , crsiHSInh :: !HSSem.Inh_AGItf -- current inh attrs for HS sem , crsiEHInh :: !EHSem.Inh_AGItf -- current inh attrs for EH sem , crsiCoreInh :: !Core2GrSem.Inh_CodeAGItf -- current inh attrs for Core2Grin sem+ , crsiCore2RunInh :: !CoreRun.Nm2RefMp -- current inh attrs for Core2CoreRun sem , crsiMbMainNm :: !(Maybe HsName) -- name of main module, if any , crsiHSModInh :: !HSSemMod.Inh_AGItf -- current inh attrs for HS module analysis sem , crsiModMp :: !ModMp -- import/export info for modules@@ -109,7 +114,7 @@ , crsiFilesToRm :: ![FPath] -- files to clean up (remove) } -{-# LINE 150 "src/ehc/EHC/CompileRun.chs" #-}+{-# LINE 156 "src/ehc/EHC/CompileRun.chs" #-} emptyEHCompileRunStateInfo :: EHCompileRunStateInfo emptyEHCompileRunStateInfo = EHCompileRunStateInfo@@ -119,6 +124,7 @@ , crsiHSInh = panic "emptyEHCompileRunStateInfo.crsiHSInh" , crsiEHInh = panic "emptyEHCompileRunStateInfo.crsiEHInh" , crsiCoreInh = panic "emptyEHCompileRunStateInfo.crsiCoreInh"+ , crsiCore2RunInh = panic "emptyEHCompileRunStateInfo.crsiCoreRunInh" , crsiMbMainNm = Nothing , crsiHSModInh = panic "emptyEHCompileRunStateInfo.crsiHSModInh" , crsiModMp = Map.empty@@ -129,7 +135,7 @@ , crsiFilesToRm = [] } -{-# LINE 179 "src/ehc/EHC/CompileRun.chs" #-}+{-# LINE 188 "src/ehc/EHC/CompileRun.chs" #-} crsiExpNmOffMpDbg :: String -> HsName -> EHCompileRunStateInfo -> VA.HsName2FldMp crsiExpNmOffMpDbg ctxt modNm crsi = mmiNmOffMp $ panicJust ("crsiExpNmOffMp." ++ ctxt ++ show ks ++ ": " ++ show modNm) $ Map.lookup modNm $ crsiModMp crsi where ks = Map.keys $ crsiModMp crsi@@ -137,22 +143,45 @@ crsiExpNmOffMp :: HsName -> EHCompileRunStateInfo -> VA.HsName2FldMp crsiExpNmOffMp modNm crsi = mmiNmOffMp $ panicJust ("crsiExpNmOffMp: " ++ show modNm) $ Map.lookup modNm $ crsiModMp crsi -{-# LINE 188 "src/ehc/EHC/CompileRun.chs" #-}+{-# LINE 197 "src/ehc/EHC/CompileRun.chs" #-} instance Show EHCompileRunStateInfo where show _ = "EHCompileRunStateInfo" instance PP EHCompileRunStateInfo where pp i = "CRSI:" >#< ppModMp (crsiModMp i) -{-# LINE 196 "src/ehc/EHC/CompileRun.chs" #-}+{-# LINE 205 "src/ehc/EHC/CompileRun.chs" #-} instance CompileRunStateInfo EHCompileRunStateInfo HsName () where crsiImportPosOfCUKey n i = () -{-# LINE 201 "src/ehc/EHC/CompileRun.chs" #-}-type EHCompileRun = CompileRun HsName EHCompileUnit EHCompileRunStateInfo Err-type EHCompilePhase a = CompilePhase HsName EHCompileUnit EHCompileRunStateInfo Err a- {-# LINE 210 "src/ehc/EHC/CompileRun.chs" #-}+class (MonadIO m, CompileRunner EHCompileUnitState HsName () FileLoc EHCompileUnit EHCompileRunStateInfo Err (EHCompilePhaseAddonT m)) => EHCCompileRunner m where++instance ( CompileRunStateInfo EHCompileRunStateInfo HsName ()+ , CompileUnit EHCompileUnit HsName FileLoc EHCompileUnitState+ , CompileRunError Err ()+ -- , MonadError (CompileRunState Err) m+ -- , MonadState EHCompileRun (EHCompilePhaseAddonT m)+ , MonadIO m -- (EHCompilePhaseAddonT m)+ , Monad m+ ) => CompileRunner EHCompileUnitState HsName () FileLoc EHCompileUnit EHCompileRunStateInfo Err (EHCompilePhaseAddonT m)++instance ( CompileRunStateInfo EHCompileRunStateInfo HsName ()+ , CompileUnit EHCompileUnit HsName FileLoc EHCompileUnitState+ , CompileRunError Err ()+ -- , MonadError (CompileRunState Err) m+ -- , MonadState EHCompileRun (EHCompilePhaseAddonT m)+ , MonadIO m -- (EHCompilePhaseAddonT m)+ , Monad m+ ) => EHCCompileRunner m++{-# LINE 232 "src/ehc/EHC/CompileRun.chs" #-}+type EHCompileRun = CompileRun HsName EHCompileUnit EHCompileRunStateInfo Err+type EHCompilePhaseAddonT m = StateT EHCompileRun m+type EHCompilePhaseT m = CompilePhaseT HsName EHCompileUnit EHCompileRunStateInfo Err (EHCompilePhaseAddonT m)+type EHCompilePhase = EHCompilePhaseT IO++{-# LINE 244 "src/ehc/EHC/CompileRun.chs" #-} crBaseInfo' :: EHCompileRun -> (EHCompileRunStateInfo,EHCOpts) crBaseInfo' cr = (crsi,opts)@@ -178,47 +207,47 @@ ) where (mbEcu, crsi, opts, mbFp) = crMbBaseInfo modNm cr -{-# LINE 245 "src/ehc/EHC/CompileRun.chs" #-}-cpMemUsage :: EHCompilePhase ()+{-# LINE 279 "src/ehc/EHC/CompileRun.chs" #-}+cpMemUsage :: EHCCompileRunner m => EHCompilePhaseT m () cpMemUsage = return () -{-# LINE 268 "src/ehc/EHC/CompileRun.chs" #-}-cpUpdOpts :: (EHCOpts -> EHCOpts) -> EHCompilePhase ()+{-# LINE 302 "src/ehc/EHC/CompileRun.chs" #-}+cpUpdOpts :: EHCCompileRunner m => (EHCOpts -> EHCOpts) -> EHCompilePhaseT m () cpUpdOpts upd = cpUpdSI (\crsi -> crsi {crsiOpts = upd $ crsiOpts crsi}) -{-# LINE 278 "src/ehc/EHC/CompileRun.chs" #-}-cpRegisterFilesToRm :: [FPath] -> EHCompilePhase ()+{-# LINE 312 "src/ehc/EHC/CompileRun.chs" #-}+cpRegisterFilesToRm :: EHCCompileRunner m => [FPath] -> EHCompilePhaseT m () cpRegisterFilesToRm fpL = cpUpdSI (\crsi -> crsi {crsiFilesToRm = fpL ++ crsiFilesToRm crsi}) -{-# LINE 284 "src/ehc/EHC/CompileRun.chs" #-}-cpRmFilesToRm :: EHCompilePhase ()+{-# LINE 318 "src/ehc/EHC/CompileRun.chs" #-}+cpRmFilesToRm :: EHCCompileRunner m => EHCompilePhaseT m () cpRmFilesToRm = do { cr <- get ; let (crsi,opts) = crBaseInfo' cr files = Set.toList $ Set.fromList $ map fpathToStr $ crsiFilesToRm crsi- ; lift $ mapM rm files+ ; liftIO $ mapM rm files ; cpUpdSI (\crsi -> crsi {crsiFilesToRm = []}) } where rm f = CE.catch (removeFile f) (\(e :: SomeException) -> hPutStrLn stderr (show f ++ ": " ++ show e)) -{-# LINE 301 "src/ehc/EHC/CompileRun.chs" #-}-cpMsg :: HsName -> Verbosity -> String -> EHCompilePhase ()+{-# LINE 335 "src/ehc/EHC/CompileRun.chs" #-}+cpMsg :: EHCCompileRunner m => HsName -> Verbosity -> String -> EHCompilePhaseT m () cpMsg modNm v m = do { cr <- get ; let (_,_,_,mbFp) = crMbBaseInfo modNm cr ; cpMsg' modNm v m Nothing (maybe emptyFPath id mbFp) } -cpMsg' :: HsName -> Verbosity -> String -> Maybe String -> FPath -> EHCompilePhase ()+cpMsg' :: EHCCompileRunner m => HsName -> Verbosity -> String -> Maybe String -> FPath -> EHCompilePhaseT m () cpMsg' modNm v m mbInfo fp = do { cr <- get ; let (mbEcu,crsi,opts,_) = crMbBaseInfo modNm cr- ; ehcioinfo <- lift $ readIORef (crsiEHCIOInfo crsi)- ; clockTime <- lift getEHCTime+ ; ehcioinfo <- liftIO $ readIORef (crsiEHCIOInfo crsi)+ ; clockTime <- liftIO getEHCTime ; let clockStartTimePrev = ehcioinfoStartTime ehcioinfo clockTimePrev = ehcioinfoLastTime ehcioinfo clockStartTimeDiff = ehcTimeDiff clockTime clockStartTimePrev@@ -226,47 +255,47 @@ ; let t = if v >= VerboseALot then "<" ++ strBlankPad 35 (ehcTimeDiffFmt clockStartTimeDiff ++ "/" ++ ehcTimeDiffFmt clockTimeDiff) ++ ">" else "" m' = maybe "" (\ecu -> show (ecuSeqNr ecu) ++ t ++ " ") mbEcu ++ m- ; lift $ putCompileMsg v (ehcOptVerbosity opts) m' mbInfo modNm fp- ; clockTime <- lift getEHCTime- ; lift $ writeIORef (crsiEHCIOInfo crsi) (ehcioinfo {ehcioinfoLastTime = clockTime})+ ; liftIO $ putCompileMsg v (ehcOptVerbosity opts) m' mbInfo modNm fp+ ; clockTime <- liftIO getEHCTime+ ; liftIO $ writeIORef (crsiEHCIOInfo crsi) (ehcioinfo {ehcioinfoLastTime = clockTime}) -- ; cpUpdSI (\crsi -> crsi { crsiTime = clockTime }) ; cpMemUsage } -{-# LINE 342 "src/ehc/EHC/CompileRun.chs" #-}-cpStepUID :: EHCompilePhase ()+{-# LINE 376 "src/ehc/EHC/CompileRun.chs" #-}+cpStepUID :: EHCCompileRunner m => EHCompilePhaseT m () cpStepUID = cpUpdSI (\crsi -> let (n,h) = mkNewLevUID (crsiNextUID crsi) in crsi {crsiNextUID = n, crsiHereUID = h} ) -cpSetUID :: UID -> EHCompilePhase ()+cpSetUID :: EHCCompileRunner m => UID -> EHCompilePhaseT m () cpSetUID u = cpUpdSI (\crsi -> crsi {crsiNextUID = u}) -{-# LINE 358 "src/ehc/EHC/CompileRun.chs" #-}-cpSystem' :: Maybe FilePath -> (FilePath,[String]) -> EHCompilePhase ()+{-# LINE 392 "src/ehc/EHC/CompileRun.chs" #-}+cpSystem' :: EHCCompileRunner m => Maybe FilePath -> (FilePath,[String]) -> EHCompilePhaseT m () cpSystem' mbStdOut (cmd,args)- = do { exitCode <- lift $ system $ showShellCmd $ (cmd,args ++ (maybe [] (\o -> [">", o]) mbStdOut))+ = do { exitCode <- liftIO $ system $ showShellCmd $ (cmd,args ++ (maybe [] (\o -> [">", o]) mbStdOut)) ; case exitCode of ExitSuccess -> return () _ -> cpSetFail } -cpSystem :: (FilePath,[String]) -> EHCompilePhase ()+cpSystem :: EHCCompileRunner m => (FilePath,[String]) -> EHCompilePhaseT m () cpSystem = cpSystem' Nothing -{-# LINE 388 "src/ehc/EHC/CompileRun.chs" #-}-cpSystemRaw :: String -> [String] -> EHCompilePhase ()+{-# LINE 422 "src/ehc/EHC/CompileRun.chs" #-}+cpSystemRaw :: EHCCompileRunner m => String -> [String] -> EHCompilePhaseT m () cpSystemRaw cmd args- = do { exitCode <- lift $ rawSystem cmd args+ = do { exitCode <- liftIO $ rawSystem cmd args ; case exitCode of ExitSuccess -> return () _ -> cpSetErrs [rngLift emptyRange Err_PP $ pp $ show exitCode] -- cpSetFail } -{-# LINE 402 "src/ehc/EHC/CompileRun.chs" #-}-cpStopAt :: CompilePoint -> EHCompilePhase ()+{-# LINE 436 "src/ehc/EHC/CompileRun.chs" #-}+cpStopAt :: EHCCompileRunner m => CompilePoint -> EHCompilePhaseT m () cpStopAt atPhase = do { cr <- get ; let (_,opts) = crBaseInfo' cr@@ -274,7 +303,7 @@ cpSetStopAllSeq } -{-# LINE 416 "src/ehc/EHC/CompileRun.chs" #-}+{-# LINE 450 "src/ehc/EHC/CompileRun.chs" #-} crPartitionNewerOlderImports :: HsName -> EHCompileRun -> ([EHCompileUnit],[EHCompileUnit]) crPartitionNewerOlderImports modNm cr = partition isNewer $ map (flip crCU cr) $ ecuImpNmL ecu@@ -286,12 +315,12 @@ where t' = panicJust "crPartitionNewerOlderImports2" $ ecuMbHIInfoTime ecu' mbt = ecuMbHIInfoTime ecu' -{-# LINE 433 "src/ehc/EHC/CompileRun.chs" #-}+{-# LINE 467 "src/ehc/EHC/CompileRun.chs" #-} -- | Partition modules into main and non main (i.e. imported) module names crPartitionMainAndImported :: EHCompileRun -> [HsName] -> ([HsName], [HsName]) crPartitionMainAndImported cr modNmL = partition (\n -> ecuHasMain $ crCU n cr) modNmL -{-# LINE 443 "src/ehc/EHC/CompileRun.chs" #-}+{-# LINE 477 "src/ehc/EHC/CompileRun.chs" #-} crModNeedsCompile :: HsName -> EHCompileRun -> Bool crModNeedsCompile modNm cr = ecuIsMainMod ecu -- ecuIsTopMod ecu@@ -303,13 +332,13 @@ (newer,_) = crPartitionNewerOlderImports modNm cr opts = crsiOpts $ crStateInfo cr -{-# LINE 464 "src/ehc/EHC/CompileRun.chs" #-}+{-# LINE 498 "src/ehc/EHC/CompileRun.chs" #-} crModCanCompile :: HsName -> EHCompileRun -> Bool crModCanCompile modNm cr = isJust (ecuMbSrcTime ecu) && ecuDirIsWritable ecu where ecu = crCU modNm cr -{-# LINE 475 "src/ehc/EHC/CompileRun.chs" #-}+{-# LINE 509 "src/ehc/EHC/CompileRun.chs" #-} -- | split module names in those part of a package, and others crPartitionIntoPkgAndOthers :: EHCompileRun -> [HsName] -> ([PkgModulePartition],[HsName]) crPartitionIntoPkgAndOthers cr modNmL@@ -324,8 +353,8 @@ FileLocKind_Pkg p d -> ([((p,d),[m])], [ ]) where (ecu,_,_,_) = crBaseInfo m cr -{-# LINE 495 "src/ehc/EHC/CompileRun.chs" #-}-crSetAndCheckMain :: HsName -> EHCompilePhase ()+{-# LINE 529 "src/ehc/EHC/CompileRun.chs" #-}+crSetAndCheckMain :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () crSetAndCheckMain modNm = do { cr <- get ; let (crsi,opts) = crBaseInfo' cr
@@ -7,6 +7,10 @@ , ecuStoreCoreSemMod , ecuStoreCoreSem , ecuStoreCore+, ecuStoreCoreRun+, ecuStoreCoreRunSemMod+, ecuStoreCore2CoreRunSem+, ecuSrcHasSuffix , Optim (..), defaultOptim , ecuHSDeclImpNmS, ecuHIDeclImpNmS, ecuHIUsedImpNmS , ecuIsMainMod@@ -15,6 +19,7 @@ , ecuIsOrphan , ecuStoreHSDeclImpS, ecuSetNeedsCompile, ecuStoreHIUsedImpS, ecuStoreHIInfoTime, ecuStoreSrcTime, ecuStoreHSSemMod, ecuStoreIntrodModS, ecuStoreHIDeclImpS, ecuStoreMod, ecuSetIsTopMod, ecuSetHasMain, ecuStoreOptim, ecuStoreHIInfo, ecuStorePrevHIInfo , ecuStoreCoreTime+, ecuStoreCoreRunTime , ecuStoreDirIsWritable , ecuIsHSNewerThanHI , ecuIsValidHIInfo@@ -31,10 +36,13 @@ import qualified UHC.Light.Compiler.HS as HS import qualified UHC.Light.Compiler.EH as EH import qualified UHC.Light.Compiler.Core as Core+import qualified UHC.Light.Compiler.CoreRun as CoreRun import qualified UHC.Light.Compiler.EH.MainAG as EHSem import qualified UHC.Light.Compiler.HS.MainAG as HSSem import qualified UHC.Light.Compiler.Core.ToGrin as Core2GrSem+import qualified UHC.Light.Compiler.Core.ToCoreRun as Core2CoreRunSem import qualified UHC.Light.Compiler.Core.Check as Core2ChkSem+import qualified UHC.Light.Compiler.CoreRun.Check as CoreRun2ChkSem import qualified UHC.Light.Compiler.HI as HI import qualified UHC.Light.Compiler.HS.ModImpExp as HSSemMod import UHC.Light.Compiler.Module.ImportExport@@ -52,7 +60,10 @@ -{-# LINE 92 "src/ehc/EHC/CompileUnit.chs" #-}++++{-# LINE 99 "src/ehc/EHC/CompileUnit.chs" #-} data Optim = Optim @@ -60,7 +71,7 @@ defaultOptim = Optim -{-# LINE 115 "src/ehc/EHC/CompileUnit.chs" #-}+{-# LINE 122 "src/ehc/EHC/CompileUnit.chs" #-} data EHCCompileSeqNr = EHCCompileSeqNr { ecseqnrThis :: !Int@@ -77,7 +88,7 @@ where tot = show total ths = show this -{-# LINE 137 "src/ehc/EHC/CompileUnit.chs" #-}+{-# LINE 144 "src/ehc/EHC/CompileUnit.chs" #-} data EHCompileUnit = EHCompileUnit { ecuSrcFilePath :: !FPath@@ -91,7 +102,10 @@ , ecuMbEHSem :: !(Maybe EHSem.Syn_AGItf) , ecuMbCore :: !(Maybe Core.CModule) , ecuMbCoreSem :: !(Maybe Core2GrSem.Syn_CodeAGItf)+ , ecuMbCore2CoreRunSem :: !(Maybe Core2CoreRunSem.Syn_CodeAGItf) , ecuMbCoreSemMod :: !(Maybe Core2ChkSem.Syn_CodeAGItf)+ , ecuMbCoreRun :: !(Maybe CoreRun.Mod)+ , ecuMbCoreRunSemMod :: !(Maybe CoreRun2ChkSem.Syn_AGItf) , ecuState :: !EHCompileUnitState , ecuImportUsedModules :: !ImportUsedModules -- imported modules info , ecuIsTopMod :: !Bool -- module has been specified for compilation on commandline@@ -100,6 +114,7 @@ , ecuMbSrcTime :: !(Maybe ClockTime) -- timestamp of possibly absent source (hs, or other type) file , ecuMbHIInfoTime :: !(Maybe ClockTime) -- timestamp of possibly previously generated hi file , ecuMbCoreTime :: !(Maybe ClockTime) -- timestamp of possibly previously generated core file+ , ecuMbCoreRunTime :: !(Maybe ClockTime) -- timestamp of possibly previously generated corerun file , ecuMbHSSemMod :: !(Maybe HSSemMod.Syn_AGItf) , ecuMod :: !Mod -- import/export info of module , ecuMbPrevHIInfo :: !(Maybe HI.HIInfo) -- possible HI info of previous run@@ -114,21 +129,21 @@ , ecuGenCodeFiles :: ![FPath] -- generated code files } -{-# LINE 211 "src/ehc/EHC/CompileUnit.chs" #-}+{-# LINE 230 "src/ehc/EHC/CompileUnit.chs" #-} ecuHSDeclImpNmS = iumHSDeclModules . ecuImportUsedModules ecuHIDeclImpNmS = iumHIDeclModules . ecuImportUsedModules ecuHIUsedImpNmS = iumHIUsedModules . ecuImportUsedModules -{-# LINE 217 "src/ehc/EHC/CompileUnit.chs" #-}+{-# LINE 236 "src/ehc/EHC/CompileUnit.chs" #-} ecuFilePath :: EHCompileUnit -> FPath ecuFilePath ecu = maybe (ecuSrcFilePath ecu) id (ecuMbCppFilePath ecu) -{-# LINE 227 "src/ehc/EHC/CompileUnit.chs" #-}+{-# LINE 246 "src/ehc/EHC/CompileUnit.chs" #-} ecuIsMainMod :: EHCompileUnit -> Bool ecuIsMainMod e = ecuIsTopMod e && ecuHasMain e -{-# LINE 232 "src/ehc/EHC/CompileUnit.chs" #-}+{-# LINE 251 "src/ehc/EHC/CompileUnit.chs" #-} -- | give the current value HIInfo, or the previous one ecuAnHIInfo :: EHCompileUnit -> HI.HIInfo ecuAnHIInfo e@@ -138,7 +153,7 @@ _ -> hii where hii = ecuHIInfo e -{-# LINE 243 "src/ehc/EHC/CompileUnit.chs" #-}+{-# LINE 262 "src/ehc/EHC/CompileUnit.chs" #-} emptyECU :: EHCompileUnit emptyECU = EHCompileUnit@@ -153,7 +168,10 @@ , ecuMbEHSem = Nothing , ecuMbCore = Nothing , ecuMbCoreSem = Nothing+ , ecuMbCore2CoreRunSem = Nothing , ecuMbCoreSemMod = Nothing+ , ecuMbCoreRun = Nothing+ , ecuMbCoreRunSemMod = Nothing , ecuState = ECUS_Unknown , ecuImportUsedModules = emptyImportUsedModules , ecuIsTopMod = False@@ -162,6 +180,7 @@ , ecuMbSrcTime = Nothing , ecuMbHIInfoTime = Nothing , ecuMbCoreTime = Nothing+ , ecuMbCoreRunTime = Nothing , ecuMbHSSemMod = Nothing , ecuMod = emptyMod , ecuMbPrevHIInfo = Nothing@@ -176,7 +195,7 @@ , ecuGenCodeFiles = [] } -{-# LINE 321 "src/ehc/EHC/CompileUnit.chs" #-}+{-# LINE 352 "src/ehc/EHC/CompileUnit.chs" #-} ecuImpNmS :: EHCompileUnit -> Set.Set HsName ecuImpNmS ecu = -- (\v -> tr "XX" (pp $ Set.toList v) v) $ Set.delete (ecuModNm ecu) $ Set.unions [ ecuHSDeclImpNmS ecu, ecuHIDeclImpNmS ecu, ecuHIUsedImpNmS ecu ]@@ -184,7 +203,7 @@ ecuImpNmL :: EHCompileUnit -> [HsName] ecuImpNmL = Set.toList . ecuImpNmS -- ecu = (nub $ ecuHSDeclImpNmL ecu ++ ecuHIDeclImpNmL ecu ++ ecuHIUsedImpNmL ecu) \\ [ecuModNm ecu] -{-# LINE 330 "src/ehc/EHC/CompileUnit.chs" #-}+{-# LINE 361 "src/ehc/EHC/CompileUnit.chs" #-} -- | The used modules, for linking, according to .hi info ecuTransClosedUsedModMp :: EHCompileUnit -> HI.HIInfoUsedModMp ecuTransClosedUsedModMp = HI.hiiTransClosedUsedModMp . ecuAnHIInfo@@ -193,17 +212,17 @@ ecuTransClosedOrphanModS :: EHCompileUnit -> Set.Set HsName ecuTransClosedOrphanModS = HI.hiiTransClosedOrphanModS . ecuAnHIInfo -{-# LINE 340 "src/ehc/EHC/CompileUnit.chs" #-}+{-# LINE 371 "src/ehc/EHC/CompileUnit.chs" #-} -- | Is orphan, according to .hi info ecuIsOrphan :: EHCompileUnit -> Bool ecuIsOrphan = isJust . HI.hiiMbOrphan . ecuAnHIInfo -{-# LINE 360 "src/ehc/EHC/CompileUnit.chs" #-}+{-# LINE 391 "src/ehc/EHC/CompileUnit.chs" #-} instance CompileUnitState EHCompileUnitState where cusDefault = ECUS_Eh EHStart cusUnk = ECUS_Unknown cusIsUnk = (==ECUS_Unknown)-{-# LINE 369 "src/ehc/EHC/CompileUnit.chs" #-}+{-# LINE 400 "src/ehc/EHC/CompileUnit.chs" #-} cusIsImpKnown s = case s of ECUS_Haskell HSOnlyImports -> True ECUS_Haskell HIOnlyImports -> True@@ -212,14 +231,15 @@ ECUS_Haskell HSAllSem -> True ECUS_Haskell HIAllSem -> True ECUS_Core CROnlyImports -> True+ ECUS_CoreRun CRROnlyImports -> True _ -> False -{-# LINE 385 "src/ehc/EHC/CompileUnit.chs" #-}+{-# LINE 419 "src/ehc/EHC/CompileUnit.chs" #-} instance FileLocatable EHCompileUnit FileLoc where fileLocation = ecuFileLocation noFileLocation = emptyFileLoc -{-# LINE 391 "src/ehc/EHC/CompileUnit.chs" #-}+{-# LINE 425 "src/ehc/EHC/CompileUnit.chs" #-} instance CompileUnit EHCompileUnit HsName FileLoc EHCompileUnitState where cuDefault = emptyECU cuFPath = ecuFilePath@@ -235,7 +255,7 @@ then [CompileParticipation_NoImport] else [] -instance FPathError Err+-- instance FPathError Err instance CompileRunError Err () where crePPErrL = ppErrL@@ -254,7 +274,7 @@ ":" >#< ppBracketsCommas (ecuImpNmL ecu) >|< "," >#< show (ecuState ecu) -{-# LINE 437 "src/ehc/EHC/CompileUnit.chs" #-}+{-# LINE 471 "src/ehc/EHC/CompileUnit.chs" #-} -- | The final state to be reached ecuFinalDestinationState :: EHCompileUnit -> EHCompileUnitState ecuFinalDestinationState ecu = ecuStateFinalDestination upd $ ecuState ecu@@ -264,7 +284,7 @@ | otherwise = ECUS_Haskell HIAllSem upd s = s -{-# LINE 454 "src/ehc/EHC/CompileUnit.chs" #-}+{-# LINE 488 "src/ehc/EHC/CompileUnit.chs" #-} type EcuUpdater a = a -> EHCompileUnit -> EHCompileUnit ecuStoreSrcFilePath :: EcuUpdater FPath@@ -288,19 +308,31 @@ ecuStoreEHSem :: EcuUpdater EHSem.Syn_AGItf ecuStoreEHSem x ecu = ecu { ecuMbEHSem = Just x } -{-# LINE 479 "src/ehc/EHC/CompileUnit.chs" #-}+{-# LINE 513 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreCoreSemMod :: EcuUpdater Core2ChkSem.Syn_CodeAGItf ecuStoreCoreSemMod x ecu = ecu { ecuMbCoreSemMod = Just x } -{-# LINE 484 "src/ehc/EHC/CompileUnit.chs" #-}+{-# LINE 518 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreCoreSem :: EcuUpdater Core2GrSem.Syn_CodeAGItf ecuStoreCoreSem x ecu = ecu { ecuMbCoreSem = Just x } -{-# LINE 489 "src/ehc/EHC/CompileUnit.chs" #-}+{-# LINE 523 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreCore :: EcuUpdater Core.CModule ecuStoreCore x ecu | x `seq` True = ecu { ecuMbCore = Just x } -{-# LINE 546 "src/ehc/EHC/CompileUnit.chs" #-}+{-# LINE 534 "src/ehc/EHC/CompileUnit.chs" #-}+ecuStoreCoreRun :: EcuUpdater CoreRun.Mod+ecuStoreCoreRun x ecu | x `seq` True = ecu { ecuMbCoreRun = Just x }++{-# LINE 539 "src/ehc/EHC/CompileUnit.chs" #-}+ecuStoreCoreRunSemMod :: EcuUpdater CoreRun2ChkSem.Syn_AGItf+ecuStoreCoreRunSemMod x ecu = ecu { ecuMbCoreRunSemMod = Just x }++{-# LINE 544 "src/ehc/EHC/CompileUnit.chs" #-}+ecuStoreCore2CoreRunSem :: EcuUpdater Core2CoreRunSem.Syn_CodeAGItf+ecuStoreCore2CoreRunSem x ecu = ecu { ecuMbCore2CoreRunSem = Just x }++{-# LINE 595 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreSrcTime :: EcuUpdater ClockTime ecuStoreSrcTime x ecu = ecu { ecuMbSrcTime = Just x } @@ -356,15 +388,19 @@ ecuStoreHIInfo :: EcuUpdater HI.HIInfo ecuStoreHIInfo x ecu | x `seq` True = ecu { ecuHIInfo = x } -{-# LINE 609 "src/ehc/EHC/CompileUnit.chs" #-}+{-# LINE 658 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreCoreTime :: EcuUpdater ClockTime ecuStoreCoreTime x ecu = ecu { ecuMbCoreTime = Just x } -{-# LINE 619 "src/ehc/EHC/CompileUnit.chs" #-}+{-# LINE 663 "src/ehc/EHC/CompileUnit.chs" #-}+ecuStoreCoreRunTime :: EcuUpdater ClockTime+ecuStoreCoreRunTime x ecu = ecu { ecuMbCoreRunTime = Just x }++{-# LINE 673 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreDirIsWritable :: EcuUpdater Bool ecuStoreDirIsWritable x ecu = ecu { ecuDirIsWritable = x } -{-# LINE 624 "src/ehc/EHC/CompileUnit.chs" #-}+{-# LINE 678 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreOpts :: EcuUpdater EHCOpts ecuStoreOpts x ecu = ecu { ecuMbOpts = Just x } @@ -377,18 +413,25 @@ ecuStoreUsedNames :: EcuUpdater ModEntRelFilterMp ecuStoreUsedNames x ecu = ecu { ecuUsedNames = x } -{-# LINE 638 "src/ehc/EHC/CompileUnit.chs" #-}+{-# LINE 692 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreGenCodeFiles :: EcuUpdater [FPath] ecuStoreGenCodeFiles x ecu = ecu { ecuGenCodeFiles = x } -{-# LINE 643 "src/ehc/EHC/CompileUnit.chs" #-}+{-# LINE 697 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreSeqNr :: EcuUpdater EHCCompileSeqNr ecuStoreSeqNr x ecu = ecu { ecuSeqNr = x } ecuStoreCppFilePath :: EcuUpdater FPath ecuStoreCppFilePath x ecu = ecu { ecuMbCppFilePath = Just x } -{-# LINE 655 "src/ehc/EHC/CompileUnit.chs" #-}+{-# LINE 709 "src/ehc/EHC/CompileUnit.chs" #-}+-- | Has the source file the given extension? Given suffix is stripped from possible prefixed '.'.+ecuSrcHasSuffix :: String -> EHCompileUnit -> Bool+ecuSrcHasSuffix suff ecu+ = maybe False (==suff') $ fpathMbSuff $ ecuSrcFilePath ecu+ where suff' = case suff of {('.':s) -> s; _ -> suff}++{-# LINE 717 "src/ehc/EHC/CompileUnit.chs" #-} -- | Is HS newer? -- If no HS exists False is returned. ecuIsHSNewerThanHI :: EHCompileUnit -> Bool@@ -398,14 +441,14 @@ (Nothing ,Just thi) -> False _ -> True -{-# LINE 674 "src/ehc/EHC/CompileUnit.chs" #-}+{-# LINE 736 "src/ehc/EHC/CompileUnit.chs" #-} ecuIsValidHIInfo :: EHCompileUnit -> Bool ecuIsValidHIInfo ecu = case ecuMbPrevHIInfo ecu of Just i -> HI.hiiValidity i == HI.HIValidity_Ok _ -> False -{-# LINE 682 "src/ehc/EHC/CompileUnit.chs" #-}+{-# LINE 744 "src/ehc/EHC/CompileUnit.chs" #-} -- | Can HI be used instead of HS? -- This is purely based on HI being of the right version and HS not newer. -- The need for recompilation considers dependencies on imports as well.
@@ -2,6 +2,7 @@ ( initialHSSem , initialEHSem , initialCore2GrSem+, initialCore2CoreRunSem , initialHSSemMod ) where import qualified Data.Map as Map@@ -9,6 +10,7 @@ import qualified UHC.Light.Compiler.HS.MainAG as HSSem import qualified UHC.Light.Compiler.EH.MainAG as EHSem import qualified UHC.Light.Compiler.Core.ToGrin as Core2GrSem+import qualified UHC.Light.Compiler.CoreRun as CoreRun import UHC.Light.Compiler.LamInfo import qualified UHC.Light.Compiler.Gam.ClGam as Pr (initClGam) import qualified UHC.Light.Compiler.HS.ModImpExp as HSSemMod@@ -23,7 +25,8 @@ -{-# LINE 51 "src/ehc/EHC/InitialSetup.chs" #-}++{-# LINE 53 "src/ehc/EHC/InitialSetup.chs" #-} initialHSSem :: EHCOpts -> HSSem.Inh_AGItf initialHSSem opts = HSSem.Inh_AGItf@@ -40,7 +43,7 @@ , HSSem.topInstanceNmL_Inh_AGItf = [] } -{-# LINE 73 "src/ehc/EHC/InitialSetup.chs" #-}+{-# LINE 75 "src/ehc/EHC/InitialSetup.chs" #-} initialEHSem :: EHCOpts -> FPath -> EHSem.Inh_AGItf initialEHSem opts fp = EHSem.Inh_AGItf@@ -62,7 +65,7 @@ , EHSem.moduleImportExportImpl_Inh_AGItf = emptyModuleImportExportImpl } -{-# LINE 102 "src/ehc/EHC/InitialSetup.chs" #-}+{-# LINE 104 "src/ehc/EHC/InitialSetup.chs" #-} initialCore2GrSem :: EHCOpts -> Core2GrSem.Inh_CodeAGItf initialCore2GrSem opts = Core2GrSem.Inh_CodeAGItf@@ -73,7 +76,11 @@ , Core2GrSem.importUsedModules_Inh_CodeAGItf = emptyImportUsedModules } -{-# LINE 116 "src/ehc/EHC/InitialSetup.chs" #-}+{-# LINE 118 "src/ehc/EHC/InitialSetup.chs" #-}+initialCore2CoreRunSem :: CoreRun.Nm2RefMp+initialCore2CoreRunSem = CoreRun.emptyNm2RefMp++{-# LINE 123 "src/ehc/EHC/InitialSetup.chs" #-} initialHSSemMod :: EHCOpts -> HSSemMod.Inh_AGItf initialHSSemMod opts = HSSemMod.Inh_AGItf
@@ -9,6 +9,7 @@ import qualified UHC.Light.Compiler.Config as Cfg import UHC.Light.Compiler.EHC.Common import UHC.Light.Compiler.EHC.Main.Utils+import qualified Control.Exception as CE import UHC.Light.Compiler.EHC.Environment import UHC.Light.Compiler.EHC.CompileUnit import UHC.Light.Compiler.EHC.CompileRun@@ -18,6 +19,7 @@ import qualified Data.Map as Map import qualified Data.Set as Set import Control.Monad.State+import Control.Monad.Error import UHC.Light.Compiler.Base.Target import UHC.Light.Compiler.Base.Optimize (allOptimizeMp) import qualified UHC.Light.Compiler.SourceCodeSig as Sig@@ -40,13 +42,14 @@ -{-# LINE 94 "src/ehc/EHC/Main.chs" #-}++{-# LINE 96 "src/ehc/EHC/Main.chs" #-} mainEHC :: EHCOpts -> IO () mainEHC opts0 = do { args <- getArgs ; progName <- getProgName ; curDir <- getCurrentDirectory- -- an empty data dir means we are running as cabal installed exec+ -- a non-empty data dir means we are running as cabal installed exec ; mbDataDir <- Cfg.getDataDir >>= \d -> return $ if null d then Nothing else Just d ; let opts1 = opts0 { ehcOptEnvironment = defaultEHCEnvironment@@ -90,12 +93,12 @@ } where envkey opts = mkEhcenvKey (Cfg.verFull Cfg.version) (fpathToStr $ ehcProgName opts) Cfg.ehcDefaultVariant -{-# LINE 189 "src/ehc/EHC/Main.chs" #-}+{-# LINE 191 "src/ehc/EHC/Main.chs" #-} defaultEHCEnvironment :: EHCEnvironment defaultEHCEnvironment = EHCEnvironment Cfg.ehcDefaultVariant Cfg.ehcDefaultInplaceInstallDir -{-# LINE 267 "src/ehc/EHC/Main.chs" #-}+{-# LINE 269 "src/ehc/EHC/Main.chs" #-} doCompilePrepare :: [String] -> EHCOpts -> IO (Maybe (EHCOpts,[FPath],[HsName],EHCompileRun)) doCompilePrepare fnL@(fn:_) opts = do { let fpL@(fp:_) = map (mkTopLevelFPath "hs") fnL@@ -163,6 +166,7 @@ (initialHSSem opts3) (initialEHSem opts3 fp) (initialCore2GrSem opts3)+ initialCore2CoreRunSem Nothing -- (initialHISem opts3) (initialHSSemMod opts3)@@ -188,13 +192,16 @@ ; when (ehcOptVerbosity opts >= VerboseDebug) (putStrLn $ "search path: " ++ show searchPath) ; _ <- if False -- ehcOptPriv opts- then runStateT (compile2 opts fileSuffMpHs searchPath fpL topModNmL) initialState- else runStateT (compile opts fileSuffMpHs searchPath fpL topModNmL) initialState+ then run initialState $ compile2 opts fileSuffMpHs searchPath fpL topModNmL+ else run initialState $ compile opts fileSuffMpHs searchPath fpL topModNmL ; return () } else exitFailure }- where compile2 :: EHCOpts -> FileSuffMp -> FileLocPath -> [FPath] -> [HsName] -> EHCompilePhase ()+ where -- run s c = {- runErrorT $ -} runStateT (runCompilePhaseT c) s+ run s c = runStateT (runCompilePhaseT c) s+ -- compile2 :: EHCCompileRunner m => EHCOpts -> FileSuffMp -> FileLocPath -> [FPath] -> [HsName] -> EHCompilePhaseT m ()+ compile2 :: EHCOpts -> FileSuffMp -> FileLocPath -> [FPath] -> [HsName] -> EHCompilePhase () compile2 opts fileSuffMpHs searchPath fpL topModNmL = do { -- start with directly importing top modules, providing the filepath directly@@ -229,10 +236,11 @@ {- showCompileOrder = do { cr <- get- ; lift $ putStrLn $ "compile order: " ++ show (crCompileOrder cr)+ ; liftIO $ putStrLn $ "compile order: " ++ show (crCompileOrder cr) } -} + -- compile :: EHCCompileRunner m => EHCOpts -> FileSuffMp -> FileLocPath -> [FPath] -> [HsName] -> EHCompilePhaseT m () compile :: EHCOpts -> FileSuffMp -> FileLocPath -> [FPath] -> [HsName] -> EHCompilePhase () compile opts fileSuffMpHs searchPath fpL topModNmL@(modNm:_) = do { cpMsg modNm VerboseDebug $ "doCompileRun.compile topModNmL: " ++ show topModNmL@@ -276,6 +284,7 @@ imp = imp1 opts fileSuffMpHs searchPath -- import others, but then in a (slightly) different way+ -- importAlso :: EHCCompileRunner m => EHCompileUnitState -> (EHCompileUnit -> Set.Set HsName) -> EHCompilePhaseT m () importAlso :: EHCompileUnitState -> (EHCompileUnit -> Set.Set HsName) -> EHCompilePhase () importAlso how getNms = do { cr <- get@@ -286,6 +295,7 @@ (imp how Nothing) (Set.toList allNewS) } + -- imp1 :: EHCCompileRunner m => EHCOpts -> FileSuffMp -> FileLocPath -> EHCompileUnitState -> Maybe FPath -> Maybe (HsName,(FPath,FileLoc)) -> HsName -> EHCompilePhaseT m (HsName,Maybe (HsName,(FPath,FileLoc))) imp1 :: EHCOpts -> FileSuffMp -> FileLocPath -> EHCompileUnitState -> Maybe FPath -> Maybe (HsName,(FPath,FileLoc)) -> HsName -> EHCompilePhase (HsName,Maybe (HsName,(FPath,FileLoc))) imp1 opts fileSuffMpHs searchPath desiredState mbFp mbPrev nm = do { let isTopModule = isJust mbFp@@ -293,8 +303,8 @@ ; let searchPath' = adaptedSearchPath mbPrev ; fpsFound <- cpFindFilesForFPathInLocations (fileLocSearch opts) (\(x,_,_) -> x) False fileSuffMpHs' searchPath' (Just nm) mbFp ; when (ehcOptVerbosity opts >= VerboseDebug)- (do { lift $ putStrLn $ show nm ++ ": " ++ show (fmap fpathToStr mbFp) ++ ": " ++ show (map fpathToStr fpsFound)- ; lift $ putStrLn $ "searchPath: " ++ show searchPath'+ (do { liftIO $ putStrLn $ show nm ++ ": " ++ show (fmap fpathToStr mbFp) ++ ": " ++ show (map fpathToStr fpsFound)+ ; liftIO $ putStrLn $ "searchPath: " ++ show searchPath' }) ; when isTopModule (cpUpdCU nm (ecuSetIsTopMod True))
@@ -82,6 +82,7 @@ , ( Just "lhs" , ECUS_Haskell LHSStart, True ) , ( Just "eh" , ECUS_Eh EHStart, True ) , ( Just "hi" , ECUS_Haskell HIStart, False )+ , ( Just Cfg.suffixDotlessBinaryCoreRun , ECUS_CoreRun CRRStartBinary, True ) , ( Just Cfg.suffixDotlessInputOutputTextualCore, ECUS_Core CRStartText, True ) , ( Just Cfg.suffixDotlessInputOutputBinaryCore , ECUS_Core CRStartBinary, True ) , ( Just Cfg.suffixDotlessBinaryCore , ECUS_Core CRStartBinary, False )@@ -93,7 +94,7 @@ else [] ) -{-# LINE 147 "src/ehc/EHC/Main/Utils.chs" #-}+{-# LINE 150 "src/ehc/EHC/Main/Utils.chs" #-} -- Suffix map for empty suffix, defaults to .hs fileSuffMpHsNoSuff :: FileSuffMp fileSuffMpHsNoSuff
@@ -67,9 +67,7 @@ data HIInfo = HIInfo { hiiValidity :: !HIValidity -- a valid HI info?- , hiiInternalVersions :: !( Cfg.InternalVersionHI -- internal version- , Cfg.InternalVersionCore- )+ , hiiInternalVersions :: !Cfg.InternalVersionCombined -- internal version , hiiOrigin :: !HIOrigin -- where did the HI come from , hiiSrcSig :: !String -- compiler source signature (md5) , hiiTarget :: !Target -- for which backend the hi is generated@@ -105,11 +103,11 @@ } deriving (Typeable, Data) -{-# LINE 147 "src/ehc/HI.chs" #-}+{-# LINE 145 "src/ehc/HI.chs" #-} emptyHIInfo :: HIInfo emptyHIInfo = HIInfo HIValidity_Absent- (Cfg.internalVersionHI, Cfg.internalVersionCore)+ Cfg.internalVersionCombined HIOrigin_FromFile "" defaultTarget defaultTargetFlavor "" "" False hsnUnknown "" "" "" "" "" Rel.empty Rel.empty emptyGam@@ -120,16 +118,16 @@ Map.empty Map.empty -{-# LINE 174 "src/ehc/HI.chs" #-}+{-# LINE 172 "src/ehc/HI.chs" #-} -- | not empty if ok hiiIsEmpty :: HIInfo -> Bool hiiIsEmpty hii = hiiValidity hii /= HIValidity_Ok -{-# LINE 180 "src/ehc/HI.chs" #-}+{-# LINE 178 "src/ehc/HI.chs" #-} hiiIdDefOccGam :: HIInfo -> IdDefOccGam hiiIdDefOccGam hii = hiiIdDefOccGamFromHIIdGam $ mentrelToIdDefOccGam (hiiModuleNm hii) (hiiExps hii) -{-# LINE 190 "src/ehc/HI.chs" #-}+{-# LINE 188 "src/ehc/HI.chs" #-} instance Show HIInfo where show _ = "HIInfo" @@ -147,11 +145,11 @@ -- >-< "Cached =" >#< ppAssocLV (assocLMapElt pp $ Map.toList $ hiiImpHIMp i) ) -{-# LINE 231 "src/ehc/HI.chs" #-}+{-# LINE 229 "src/ehc/HI.chs" #-} type ImpHIMp = Map.Map HsName HIInfo -{-# LINE 236 "src/ehc/HI.chs" #-}+{-# LINE 234 "src/ehc/HI.chs" #-} -- | combine HI info for a single module, as extracted from the cached hiiImpHIMp of the module importing these combined modules hiiUnion :: HIInfo -> HIInfo -> HIInfo hiiUnion m1 m2@@ -168,7 +166,7 @@ , hiiLamMp = hiiLamMp m1 `Map.union` hiiLamMp m2 } -{-# LINE 261 "src/ehc/HI.chs" #-}+{-# LINE 259 "src/ehc/HI.chs" #-} -- | restrict envs to the ones being in the filter map, so only those visible relative to that map remain hiiRestrictToFilterMp :: ModEntRelFilterMp -> HIInfo -> HIInfo hiiRestrictToFilterMp mfm hii@@ -194,12 +192,12 @@ fg p = fst . gamPartition (\k _ -> p k) fm p = Map.filterWithKey (\k _ -> p k) -{-# LINE 297 "src/ehc/HI.chs" #-}+{-# LINE 295 "src/ehc/HI.chs" #-} -- | restrict envs to the ones being exported, so only the visible part remains hiiRestrictToExported :: HIInfo -> HIInfo hiiRestrictToExported hii = hiiRestrictToFilterMp (mentrelToFilterMp [] (hiiExps hii) `mentrelFilterMpUnion` mentrelToFilterMp [] (hiiHiddenExps hii)) hii -{-# LINE 303 "src/ehc/HI.chs" #-}+{-# LINE 301 "src/ehc/HI.chs" #-} -- | include the imported HIInfos in this one, restricted to their exports, to be done just before saving hiiIncludeCacheOfImport :: (HsName -> HIInfo) -> ModEntRelFilterMp -> HIInfo -> HIInfo hiiIncludeCacheOfImport imp mfm hii@@ -228,7 +226,7 @@ , hiiSrcVersionSvn = "" } -{-# LINE 339 "src/ehc/HI.chs" #-}+{-# LINE 337 "src/ehc/HI.chs" #-} mentrelToIdDefOccGam :: HsName -> ModEntRel -> Gam IdOcc IdOcc -- IdDefOccGam mentrelToIdDefOccGam modNm r = gamFromAssocL@@ -241,20 +239,20 @@ n' = hsnSetQual modNm n ] -{-# LINE 357 "src/ehc/HI.chs" #-}+{-# LINE 355 "src/ehc/HI.chs" #-} hiiIdDefOccGamToHIIdGam :: IdDefOccGam -> Gam IdOcc IdOcc hiiIdDefOccGamToHIIdGam = gamMap (\(k,v) -> (k,doccOcc v)) hiiIdDefOccGamFromHIIdGam :: Gam IdOcc IdOcc -> IdDefOccGam hiiIdDefOccGamFromHIIdGam = gamMap (\(k,v) -> (k,mkIdDefOcc v IdAsp_Any nmLevOutside emptyRange)) -{-# LINE 369 "src/ehc/HI.chs" #-}+{-# LINE 367 "src/ehc/HI.chs" #-} data HIOrigin = HIOrigin_FromFile -- from .hi file | HIOrigin_FromImportedBy HsNameS -- reconstructed from modules which imported this hi deriving (Eq,Show,Typeable,Data) -{-# LINE 376 "src/ehc/HI.chs" #-}+{-# LINE 374 "src/ehc/HI.chs" #-} data HIValidity = HIValidity_Ok -- ok | HIValidity_WrongMagic -- wrong magic number@@ -262,16 +260,16 @@ | HIValidity_Absent -- not available deriving (Eq,Enum,Show,Typeable,Data) -{-# LINE 389 "src/ehc/HI.chs" #-}+{-# LINE 387 "src/ehc/HI.chs" #-} gamFlatten :: Ord k => Gam k v -> Gam k v gamFlatten = id -- gamFromAssocL . gamToAssocL -{-# LINE 398 "src/ehc/HI.chs" #-}+{-# LINE 396 "src/ehc/HI.chs" #-} instance Serialize HIValidity where sput = sputEnum8 sget = sgetEnum8 -{-# LINE 404 "src/ehc/HI.chs" #-}+{-# LINE 402 "src/ehc/HI.chs" #-} sgetHIInfo :: EHCOpts -> SGet HIInfo sgetHIInfo opts = do { hi_magic <- sequence $ replicate (length Cfg.magicNumberHI) sgetWord8@@ -369,7 +367,7 @@ } } -{-# LINE 527 "src/ehc/HI.chs" #-}+{-# LINE 525 "src/ehc/HI.chs" #-} instance Serialize HIInfo where sput (HIInfo { hiiSrcSig = hi_sig
@@ -20,7 +20,6 @@ , Optimize (..), OptimizationLevel (..) , module UHC.Light.Compiler.Base.FileSearchLocation , ehcOptWholeProgHPTAnalysis-, ehcOptEmitCore , ehcOptOptimizes , fioMkFinal , FIOBind (..)@@ -144,12 +143,6 @@ ehcOptWholeProgHPTAnalysis opts = False -{-# LINE 258 "src/ehc/Opts.chs" #-}--- generate Core-ehcOptEmitCore :: EHCOpts -> Bool-ehcOptEmitCore opts- = ehcOptWholeProgHPTAnalysis opts || targetIsCore (ehcOptTarget opts)- {-# LINE 276 "src/ehc/Opts.chs" #-} -- | optimizes a particular option ehcOptOptimizes :: Optimize -> EHCOpts -> Bool@@ -173,12 +166,6 @@ ("generate code for target, default=" ++ show defaultTarget) , Option "" ["target-flavor"] (ReqArg oTargetFlavor (showAllTargetFlavors' "|")) ("generate code for target flavor, default=" ++ show defaultTargetFlavor)- , Option "" ["version-dotted"] (NoArg oNumVersion) ("print version in \"x.y.z\" style (then stop)")- , Option "" ["version-asnumber"] (NoArg oVersionAsNumber) ("print version in \"xyz\" style (then stop)")- , Option "" ["numeric-version"] (NoArg oNumVersion) "see --version-dotted (to become obsolete)"- , Option "v" ["verbose"] (OptArg oVerbose "0|1|2|3|4") ( "be verbose, 0=quiet, 4=debug, "- ++ "default=1"- ) , Option "p" ["pretty"] (OptArg oPretty "hs|eh|ast|-") "show pretty printed source or EH abstract syntax tree, default=eh, -=off, (downstream only)" @@ -225,7 +212,7 @@ "pgm: alternate executable used by compiler, currently only P (preprocessing)" , Option "" ["coreopt"] (ReqArg oOptCore "opt[,...]") ("opts (specific) for core: " ++ showStr2stMp coreOptMp) ]-{-# LINE 480 "src/ehc/Opts.chs" #-}+{-# LINE 466 "src/ehc/Opts.chs" #-} where oPretty ms o = case ms of Just "-" -> o { ehcOptShowEH = False } Just "no" -> o { ehcOptShowEH = False }@@ -272,14 +259,6 @@ } _ -> o - oVerbose ms o = case ms of- Just "0" -> o { ehcOptVerbosity = VerboseQuiet }- Just "1" -> o { ehcOptVerbosity = VerboseMinimal }- Just "2" -> o { ehcOptVerbosity = VerboseNormal }- Just "3" -> o { ehcOptVerbosity = VerboseALot }- Just "4" -> o { ehcOptVerbosity = VerboseDebug }- Nothing -> o { ehcOptVerbosity = succ (ehcOptVerbosity o)}- _ -> o oOptimization ms o = o' {ehcOptOptimizations = optimizeRequiresClosure os} where (o',doSetOpts)@@ -342,8 +321,6 @@ oNoRecomp o = o { ehcOptCheckRecompile = False } oCompileOnly o = o { ehcOptLinkingStyle = LinkingStyle_None } oNoHiCheck o = o { ehcOptHiValidityCheck = False }- oNumVersion o = o { ehcOptImmQuit = Just ImmediateQuitOption_VersionDotted }- oVersionAsNumber o = o { ehcOptImmQuit = Just ImmediateQuitOption_VersionAsNumber } oUsrFileLocPath s o = o { ehcOptImportFileLocPath = ehcOptImportFileLocPath o ++ mkFileLocPath s } oLibFileLocPath s o = o { ehcOptLibFileLocPath = ehcOptLibFileLocPath o ++ mkFileLocPath s } oPkgdirLocPath s o = o { ehcOptPkgdirLocPath = ehcOptPkgdirLocPath o ++ mkStringPath s }@@ -384,7 +361,7 @@ nub $ ehcOptCmdLineOpts o ++ fst (parseCmdLineOpts cmd s) } oPgmExec cmd s o = o { ehcOptPgmExecMp = Map.insert cmd s $ ehcOptPgmExecMp o } -{-# LINE 779 "src/ehc/Opts.chs" #-}+{-# LINE 755 "src/ehc/Opts.chs" #-} -- | Commandline opts for ehcr/uhcr (EHCRun) ehcrunCmdLineOpts :: GetOptCmdLineOpts ehcrunCmdLineOpts@@ -396,7 +373,7 @@ where upd | b = (CoreOpt_RunTrace :) | otherwise = (\\ [CoreOpt_RunTrace]) -{-# LINE 800 "src/ehc/Opts.chs" #-}+{-# LINE 776 "src/ehc/Opts.chs" #-} -- | The description for GetOpt type GetOptCmdLineOpts = [OptDescr (EHCOpts -> EHCOpts)] @@ -405,16 +382,36 @@ sharedCmdLineOpts = [ Option "h" ["help"] (NoArg oHelp) "print this help (then stop)" , Option "" ["version"] (NoArg oVersion) "print version info (then stop)"+ , Option "" ["version-dotted"] (NoArg oNumVersion) ("print version in \"x.y.z\" style (then stop)")+ , Option "" ["version-asnumber"] (NoArg oVersionAsNumber) ("print version in \"xyz\" style (then stop)")+ , Option "" ["numeric-version"] (NoArg oNumVersion) "see --version-dotted (to become obsolete)"+ , Option "v" ["verbose"] (OptArg oVerbose "0|1|2|3|4") ( "be verbose, 0=quiet, 4=debug, "+ ++ "default=1"+ ) ] -{-# LINE 816 "src/ehc/Opts.chs" #-}+{-# LINE 806 "src/ehc/Opts.chs" #-} -- | Help oHelp o = o { ehcOptImmQuit = Just ImmediateQuitOption_Help } --- Version+-- | Version oVersion o = o { ehcOptImmQuit = Just ImmediateQuitOption_Version } -{-# LINE 828 "src/ehc/Opts.chs" #-}+-- | Verbosity+oVerbose ms o = case ms of+ Just "0" -> o { ehcOptVerbosity = VerboseQuiet }+ Just "1" -> o { ehcOptVerbosity = VerboseMinimal }+ Just "2" -> o { ehcOptVerbosity = VerboseNormal }+ Just "3" -> o { ehcOptVerbosity = VerboseALot }+ Just "4" -> o { ehcOptVerbosity = VerboseDebug }+ Nothing -> o { ehcOptVerbosity = succ (ehcOptVerbosity o)}+ _ -> o++{-# LINE 824 "src/ehc/Opts.chs" #-}+oNumVersion o = o { ehcOptImmQuit = Just ImmediateQuitOption_VersionDotted }+oVersionAsNumber o = o { ehcOptImmQuit = Just ImmediateQuitOption_VersionAsNumber }++{-# LINE 833 "src/ehc/Opts.chs" #-} -- | Int option intArg tr = ReqArg (optInt tr) "<nr>" @@ -423,7 +420,7 @@ optInt tr s o = tr o $ read s -{-# LINE 838 "src/ehc/Opts.chs" #-}+{-# LINE 843 "src/ehc/Opts.chs" #-} -- | What kind of optional args are allowed data OptArgAllow = OptArgAllow_Bool@@ -433,13 +430,13 @@ optArgAllAllow :: [OptArgAllow] optArgAllAllow = [minBound .. maxBound] -{-# LINE 849 "src/ehc/Opts.chs" #-}+{-# LINE 854 "src/ehc/Opts.chs" #-} -- | An optional arg, universal type for all occurring variants data OptArg = OptArg_Bool Bool | OptArg_Int Int -{-# LINE 856 "src/ehc/Opts.chs" #-}+{-# LINE 861 "src/ehc/Opts.chs" #-} optArgTake :: [OptArgAllow] -> String -> Maybe (OptArg,String) optArgTake allow s = case s of@@ -460,7 +457,7 @@ where yesInt = OptArgAllow_Int `elem` allow noInt = not yesInt -{-# LINE 878 "src/ehc/Opts.chs" #-}+{-# LINE 883 "src/ehc/Opts.chs" #-} optBooleanTake :: String -> Maybe (Bool,String) optBooleanTake s = case optArgTake [OptArgAllow_Bool] s of@@ -476,22 +473,22 @@ boolArgStr = "Bool" boolArg tr = OptArg (optBoolean tr) boolArgStr -{-# LINE 899 "src/ehc/Opts.chs" #-}+{-# LINE 904 "src/ehc/Opts.chs" #-} oPriv o b = o { ehcOptPriv = b } -{-# LINE 903 "src/ehc/Opts.chs" #-}+{-# LINE 908 "src/ehc/Opts.chs" #-} optDumpCoreStages o b = o { ehcOptDumpCoreStages = b } -{-# LINE 911 "src/ehc/Opts.chs" #-}+{-# LINE 916 "src/ehc/Opts.chs" #-} oSetGenTrampoline o b = o { ehcOptGenTrampoline_ = b } -{-# LINE 931 "src/ehc/Opts.chs" #-}+{-# LINE 936 "src/ehc/Opts.chs" #-} oStopAtCoreError o b = o { ehcDebugStopAtCoreError = b } -{-# LINE 935 "src/ehc/Opts.chs" #-}+{-# LINE 940 "src/ehc/Opts.chs" #-} oStopAtHIError o b = o { ehcDebugStopAtHIError = b } -{-# LINE 943 "src/ehc/Opts.chs" #-}+{-# LINE 948 "src/ehc/Opts.chs" #-} -- | Apply the cmdline opts description to a EHCOpts, returning Nothing when there were no options cmdlineOptsApply :: [OptDescr (EHCOpts -> EHCOpts)] -> [EHCOpts -> EHCOpts] -> [String] -> EHCOpts -> (Maybe EHCOpts, [String], [String]) cmdlineOptsApply cmdlopts postopts args opts@@ -507,7 +504,7 @@ ehcrunCmdLineOptsApply :: [String] -> EHCOpts -> (Maybe EHCOpts, [String], [String]) ehcrunCmdLineOptsApply = cmdlineOptsApply ehcrunCmdLineOpts [] -{-# LINE 964 "src/ehc/Opts.chs" #-}+{-# LINE 969 "src/ehc/Opts.chs" #-} optsDiscrRecompileRepr :: EHCOpts -> String optsDiscrRecompileRepr opts = concat@@ -521,12 +518,12 @@ ] where o m v = if v then m else "" -{-# LINE 985 "src/ehc/Opts.chs" #-}+{-# LINE 990 "src/ehc/Opts.chs" #-} data FIOBind = FIOBindYes | FIOBindNoBut TyVarIdS deriving (Show) -{-# LINE 991 "src/ehc/Opts.chs" #-}+{-# LINE 996 "src/ehc/Opts.chs" #-} data FIOpts = FIOpts { fioLeaveRInst :: !Bool , fioBindRFirst :: !Bool , fioBindLFirst :: !Bool , fioBindLBeforeR :: !Bool , fioMode :: !FIMode , fioUniq :: !UID@@ -539,7 +536,7 @@ , fiMbMkErrClash :: Maybe (Ty -> Ty -> Err) -- alternate error construction for type clash } -{-# LINE 1025 "src/ehc/Opts.chs" #-}+{-# LINE 1030 "src/ehc/Opts.chs" #-} fioBindNoSet :: FIOBind -> TyVarIdS fioBindNoSet (FIOBindNoBut s) = s fioBindNoSet _ = Set.empty@@ -548,7 +545,7 @@ fioBindIsYes FIOBindYes = True fioBindIsYes _ = False -{-# LINE 1035 "src/ehc/Opts.chs" #-}+{-# LINE 1040 "src/ehc/Opts.chs" #-} strongFIOpts :: FIOpts strongFIOpts = FIOpts { fioLeaveRInst = False , fioBindRFirst = True , fioBindLFirst = True , fioBindLBeforeR = True@@ -562,11 +559,11 @@ , fiMbMkErrClash = Nothing } -{-# LINE 1065 "src/ehc/Opts.chs" #-}+{-# LINE 1070 "src/ehc/Opts.chs" #-} instance Show FIOpts where show o = "FIOpts" -{-# LINE 1070 "src/ehc/Opts.chs" #-}+{-# LINE 1075 "src/ehc/Opts.chs" #-} instance PP FIOpts where pp o = "FIOpts{" >#< "leaveRInst=" >|< pp (fioLeaveRInst o)@@ -577,33 +574,33 @@ >#< "allowRPredElim=" >|< pp (fioAllowRPredElim o) >#< "}" -{-# LINE 1086 "src/ehc/Opts.chs" #-}+{-# LINE 1091 "src/ehc/Opts.chs" #-} instLFIOpts :: FIOpts instLFIOpts = strongFIOpts {fioBindRFirst = False} -{-# LINE 1091 "src/ehc/Opts.chs" #-}+{-# LINE 1096 "src/ehc/Opts.chs" #-} instLRFIOpts :: FIOpts instLRFIOpts = strongFIOpts {fioBindRFirst = False, fioBindLFirst = False} -{-# LINE 1096 "src/ehc/Opts.chs" #-}+{-# LINE 1101 "src/ehc/Opts.chs" #-} unifyFIOpts :: FIOpts unifyFIOpts = strongFIOpts {fioMode = FitUnify} instFIOpts :: FIOpts instFIOpts = instLFIOpts {fioLeaveRInst = True, fioBindLFirst = False} -{-# LINE 1115 "src/ehc/Opts.chs" #-}+{-# LINE 1120 "src/ehc/Opts.chs" #-} weakFIOpts :: FIOpts weakFIOpts = fioMkWeak strongFIOpts -{-# LINE 1120 "src/ehc/Opts.chs" #-}+{-# LINE 1125 "src/ehc/Opts.chs" #-} predFIOpts :: FIOpts predFIOpts = strongFIOpts {fioPredAsTy = True, fioLeaveRInst = True} implFIOpts :: FIOpts implFIOpts = strongFIOpts {fioAllowRPredElim = False} -{-# LINE 1128 "src/ehc/Opts.chs" #-}+{-# LINE 1133 "src/ehc/Opts.chs" #-} fioSwapOpts :: FIOpts -> FIOpts fioSwapOpts fio = fio@@ -617,24 +614,24 @@ fioSwapPolarity :: Polarity -> FIOpts -> FIOpts fioSwapPolarity pol fio = fio {fioMode = fimSwapPol pol (fioMode fio)} -{-# LINE 1145 "src/ehc/Opts.chs" #-}+{-# LINE 1150 "src/ehc/Opts.chs" #-} fioMkStrong :: FIOpts -> FIOpts fioMkStrong fi = fi {fioLeaveRInst = False, fioBindRFirst = True, fioBindLFirst = True} -{-# LINE 1150 "src/ehc/Opts.chs" #-}+{-# LINE 1155 "src/ehc/Opts.chs" #-} fioMkWeak :: FIOpts -> FIOpts fioMkWeak fi = fi {fioLeaveRInst = True, fioBindRFirst = False} -{-# LINE 1155 "src/ehc/Opts.chs" #-}+{-# LINE 1160 "src/ehc/Opts.chs" #-} -- | Adapt options for extracting final ty fioMkFinal :: FIOpts -> FIOpts fioMkFinal fi = fi {fioBindLFirst = False, fioBindRFirst = False, fioExpandEqTyVar = True} -{-# LINE 1161 "src/ehc/Opts.chs" #-}+{-# LINE 1166 "src/ehc/Opts.chs" #-} fioMkUnify :: FIOpts -> FIOpts fioMkUnify fi = fi {fioMode = FitUnify} -{-# LINE 1170 "src/ehc/Opts.chs" #-}+{-# LINE 1175 "src/ehc/Opts.chs" #-} fioIsSubsume :: FIOpts -> Bool fioIsSubsume fio = case fioMode fio of {FitSubLR -> True ; _ -> False}
@@ -197,7 +197,7 @@ emptyEHCOpts = EHCOpts { ehcOptTrace = \_ x -> x- , ehcOptAspects = "base codegen core corebackend corein coreout corerun hmtyinfer noHmTyRuler"+ , ehcOptAspects = "base codegen core corebackend corein coreout corerun corerunin hmtyinfer noHmTyRuler" , ehcOptShowHS = False , ehcOptPriv = False , ehcOptHsChecksInEH = False
@@ -191,8 +191,8 @@ = defaultScanOpts { scoKeywordsTxt = Set.fromList $ [ "alloc", "module", "tail", "eval", "case", "of", "let", "in", "app", "ffi", "dbg", "tag"- , "g", "d", "l"- , "data"+ , "g", "d", "l", "i", "m"+ , "data", "import" ] -- , scoKeywExtraChars = Set.fromList "." , scoKeywordsOps = Set.fromList [ "->", "." ]
@@ -1,3 +1,3 @@ module UHC.Light.Compiler.SourceCodeSig where-sig = "2deb5e078b2839d557ad7579c31d6c29"-timestamp = "20150201 +0100 214742"+sig = "c1a69cc04e03a2a328e75c202ca08315"+timestamp = "20150219 +0100 165739"
@@ -1,5 +1,5 @@ Name: uhc-light-Version: 1.1.8.6+Version: 1.1.8.7 License: BSD3 Copyright: Utrecht University, Department of Information and Computing Sciences, Software Technology group Build-Type: Simple @@ -12,7 +12,7 @@ Synopsis: Part of UHC packaged as cabal/hackage installable library Description: A 'light' variant of UHC including only an API and executables for compiling to Core representation (uhcl) and running CoreRun (uhcr). This version is just to test the infrastructure. Later versions will provide a fleshing out of the API and completion of the now rudimentary platform independent (Haskell) interpreted running etc.. Cabal-Version: >= 1.8-data-files: 103/lib/ag/AnaDomain/AbsSyn.ag,103/lib/ag/Cmm/AbsSyn.ag,103/lib/ag/Core/AbsSyn.ag,103/lib/ag/CoreRun/AbsSyn.ag,103/lib/ag/EH/AbsSyn.ag,103/lib/ag/Error/AbsSyn.ag,103/lib/ag/Foreign/AbsSyn.ag,103/lib/ag/GrinByteCode/AbsSyn.ag,103/lib/ag/GrinCode/AbsSyn.ag,103/lib/ag/HS/AbsSyn.ag,103/lib/ag/JavaScript/AbsSyn.ag,103/lib/ag/JVMClass/AbsSyn.ag,103/lib/ag/LLVM/AbsSyn.ag,103/lib/ag/Silly/AbsSyn.ag,103/lib/ag/Ty/AbsSyn.ag,103/lib/ag/TyCore/AbsSyn.ag,103/lib/pkg/array-1.0.0.0/103/cr/plain/Data/Array.cr,103/lib/pkg/array-1.0.0.0/103/cr/plain/Data/Array.hi,103/lib/pkg/array-1.0.0.0/103/cr/plain/installed-pkg-config,103/lib/pkg/base-3.0.0.0/103/cr/plain/CompileAll,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Applicative.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Applicative.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Arrow.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Arrow.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Category.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Category.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Fix.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Fix.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Instances.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Instances.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST/Lazy.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST/Lazy.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Bool.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Bool.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Complex.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Complex.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Dynamic.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Dynamic.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Eq.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Eq.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Foldable.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Foldable.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Function.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Function.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ix.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ix.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Monoid.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Monoid.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ord.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ord.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ratio.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ratio.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/String.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/String.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Traversable.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Traversable.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/include/consUtils.h,103/lib/pkg/base-3.0.0.0/103/cr/plain/installed-pkg-config,103/lib/pkg/base-3.0.0.0/103/cr/plain/Numeric.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Numeric.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Prelude.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Prelude.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Console/GetOpt.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Console/GetOpt.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Exit.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Exit.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadP.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadP.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadPrec.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadPrec.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read/Lex.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read/Lex.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show/Functions.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show/Functions.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Control/Monad.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Control/Monad.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Data/Bits.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Data/Bits.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Data/Char.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Data/Char.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Data/Either.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Data/Either.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Data/IORef.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Data/IORef.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Data/List.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Data/List.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Data/Maybe.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Data/Maybe.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Data/Typeable.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Data/Typeable.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Debug/Trace.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Debug/Trace.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Foreign/Ptr.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Foreign/Ptr.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Foreign/StablePtr.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Foreign/StablePtr.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/include/CTypes.h,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/include/dirUtils.h,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/include/HsBase.h,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/include/HsBaseConfig.h,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/include/IntLikeInstance.h,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/include/MachDeps.h,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/include/TupleInstance.h,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/include/Typeable.h,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/installed-pkg-config,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/System/IO/Error.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/System/IO/Error.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/System/IO/Fix.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/System/IO/Fix.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/System/IO/Unsafe.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/System/IO/Unsafe.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/System/IO.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/System/IO.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Array.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Array.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Base.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Base.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Bits.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Bits.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Bounded.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Bounded.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/BoxArray.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/BoxArray.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Char.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Char.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Enum.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Enum.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Eq.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Eq.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Float.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Float.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/GC.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/GC.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Generics/Tuple.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Generics/Tuple.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Generics.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Generics.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Handle.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Handle.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/IO.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/IO.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/IOBase.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/IOBase.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Ix.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Ix.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/LazyST.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/LazyST.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/MutVar.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/MutVar.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/MVar.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/MVar.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/OldException.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/OldException.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Ord.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Ord.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Prims.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Prims.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Ptr.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Ptr.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Read.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Read.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Real.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Real.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Run.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Run.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Show.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Show.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/ST.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/ST.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/StablePtr.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/StablePtr.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/StackTrace.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/StackTrace.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/STRef.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/STRef.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Types.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Types.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Weak.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/Weak.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/WeakPtr.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/UHC/WeakPtr.hi,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Unsafe/Coerce.cr,103/lib/pkg/uhcbase-1.1.8.6/103/cr/plain/Unsafe/Coerce.hi +data-files: 103/lib/ag/AnaDomain/AbsSyn.ag,103/lib/ag/Cmm/AbsSyn.ag,103/lib/ag/Core/AbsSyn.ag,103/lib/ag/CoreRun/AbsSyn.ag,103/lib/ag/EH/AbsSyn.ag,103/lib/ag/Error/AbsSyn.ag,103/lib/ag/Foreign/AbsSyn.ag,103/lib/ag/GrinByteCode/AbsSyn.ag,103/lib/ag/GrinCode/AbsSyn.ag,103/lib/ag/HS/AbsSyn.ag,103/lib/ag/JavaScript/AbsSyn.ag,103/lib/ag/JVMClass/AbsSyn.ag,103/lib/ag/LLVM/AbsSyn.ag,103/lib/ag/Silly/AbsSyn.ag,103/lib/ag/Ty/AbsSyn.ag,103/lib/ag/TyCore/AbsSyn.ag,103/lib/pkg/array-1.0.0.0/103/cr/plain/Data/Array.cr,103/lib/pkg/array-1.0.0.0/103/cr/plain/Data/Array.crr,103/lib/pkg/array-1.0.0.0/103/cr/plain/Data/Array.hi,103/lib/pkg/array-1.0.0.0/103/cr/plain/installed-pkg-config,103/lib/pkg/base-3.0.0.0/103/cr/plain/CompileAll,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Applicative.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Applicative.crr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Applicative.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Arrow.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Arrow.crr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Arrow.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Category.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Category.crr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Category.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Fix.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Fix.crr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Fix.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Instances.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Instances.crr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Instances.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST/Lazy.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST/Lazy.crr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST/Lazy.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST.crr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Bool.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Bool.crr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Bool.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Complex.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Complex.crr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Complex.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Dynamic.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Dynamic.crr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Dynamic.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Eq.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Eq.crr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Eq.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Foldable.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Foldable.crr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Foldable.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Function.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Function.crr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Function.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ix.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ix.crr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ix.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Monoid.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Monoid.crr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Monoid.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ord.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ord.crr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ord.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ratio.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ratio.crr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ratio.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/String.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/String.crr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/String.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Traversable.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Traversable.crr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Traversable.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/include/consUtils.h,103/lib/pkg/base-3.0.0.0/103/cr/plain/installed-pkg-config,103/lib/pkg/base-3.0.0.0/103/cr/plain/Numeric.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Numeric.crr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Numeric.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Prelude.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Prelude.crr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Prelude.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Console/GetOpt.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Console/GetOpt.crr,103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Console/GetOpt.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Exit.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Exit.crr,103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Exit.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadP.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadP.crr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadP.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadPrec.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadPrec.crr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadPrec.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read/Lex.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read/Lex.crr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read/Lex.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read.crr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show/Functions.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show/Functions.crr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show/Functions.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show.crr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Control/Monad.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Control/Monad.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Control/Monad.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/Bits.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/Bits.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/Bits.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/Char.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/Char.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/Char.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/Either.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/Either.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/Either.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/IORef.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/IORef.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/IORef.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/List.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/List.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/List.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/Maybe.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/Maybe.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/Maybe.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/Typeable.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/Typeable.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Data/Typeable.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Debug/Trace.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Debug/Trace.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Debug/Trace.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Foreign/Ptr.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Foreign/Ptr.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Foreign/Ptr.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Foreign/StablePtr.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Foreign/StablePtr.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Foreign/StablePtr.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/include/CTypes.h,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/include/dirUtils.h,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/include/HsBase.h,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/include/HsBaseConfig.h,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/include/IntLikeInstance.h,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/include/MachDeps.h,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/include/TupleInstance.h,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/include/Typeable.h,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/installed-pkg-config,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/System/IO/Error.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/System/IO/Error.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/System/IO/Error.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/System/IO/Fix.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/System/IO/Fix.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/System/IO/Fix.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/System/IO/Unsafe.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/System/IO/Unsafe.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/System/IO/Unsafe.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/System/IO.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/System/IO.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/System/IO.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Array.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Array.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Array.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Base.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Base.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Base.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Bits.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Bits.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Bits.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Bounded.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Bounded.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Bounded.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/BoxArray.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/BoxArray.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/BoxArray.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Char.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Char.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Char.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Enum.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Enum.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Enum.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Eq.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Eq.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Eq.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Float.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Float.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Float.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/GC.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/GC.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/GC.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Generics/Tuple.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Generics/Tuple.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Generics/Tuple.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Generics.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Generics.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Generics.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Handle.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Handle.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Handle.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/IO.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/IO.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/IO.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/IOBase.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/IOBase.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/IOBase.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Ix.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Ix.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Ix.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/LazyST.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/LazyST.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/LazyST.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/MutVar.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/MutVar.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/MutVar.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/MVar.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/MVar.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/MVar.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/OldException.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/OldException.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/OldException.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Ord.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Ord.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Ord.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Prims.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Prims.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Prims.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Ptr.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Ptr.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Ptr.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Read.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Read.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Read.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Real.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Real.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Real.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Run.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Run.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Run.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Show.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Show.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Show.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/ST.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/ST.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/ST.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/StablePtr.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/StablePtr.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/StablePtr.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/StackTrace.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/StackTrace.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/StackTrace.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/STRef.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/STRef.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/STRef.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Types.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Types.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Types.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Weak.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Weak.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/Weak.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/WeakPtr.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/WeakPtr.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/UHC/WeakPtr.hi,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Unsafe/Coerce.cr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Unsafe/Coerce.crr,103/lib/pkg/uhcbase-1.1.8.7/103/cr/plain/Unsafe/Coerce.hi extra-source-files: changelog.md Library@@ -20,16 +20,16 @@ Build-Depends: fgl,hashable>=1.1&&<1.3,uhc-util>=0.1.3.7,base>=4&&<5,vector,syb,uulib,network,binary,mtl,directory,containers,array,process,primitive,binary,syb,bytestring,uulib>=0.9.12,old-locale Extensions: RankNTypes,MultiParamTypeClasses,FunctionalDependencies,UndecidableInstances,DeriveDataTypeable,OverlappingInstances,LiberalTypeSynonyms,StandaloneDeriving,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,ScopedTypeVariables Exposed-Modules: UHC.Light.Compiler.API,UHC.Light.Compiler.Base.API,UHC.Light.Compiler.Core.API,UHC.Light.Compiler.CoreRun.API,UHC.Light.Compiler.CoreRun.API.Internal,UHC.Light.Compiler.EHC.Main,UHC.Light.Compiler.EHC.Main.Utils - Other-Modules: Paths_uhc_light,UHC.Light.Compiler.AbstractCore,UHC.Light.Compiler.AbstractCore.Utils,UHC.Light.Compiler.AnaDomain,UHC.Light.Compiler.AnaDomain.Ftv,UHC.Light.Compiler.AnaDomain.Pretty,UHC.Light.Compiler.AnaDomain.Trf.Instantiate,UHC.Light.Compiler.AnaDomain.Trf.Subst,UHC.Light.Compiler.AnaDomain.Utils,UHC.Light.Compiler.Base.CfgPP,UHC.Light.Compiler.Base.Common,UHC.Light.Compiler.Base.Debug,UHC.Light.Compiler.Base.FileSearchLocation,UHC.Light.Compiler.Base.Fld,UHC.Light.Compiler.Base.HsName,UHC.Light.Compiler.Base.HsName.Builtin,UHC.Light.Compiler.Base.Optimize,UHC.Light.Compiler.Base.PackageDatabase,UHC.Light.Compiler.Base.ParseUtils,UHC.Light.Compiler.Base.Parser,UHC.Light.Compiler.Base.Parser2,UHC.Light.Compiler.Base.Pragma,UHC.Light.Compiler.Base.RLList,UHC.Light.Compiler.Base.Range,UHC.Light.Compiler.Base.Strictness,UHC.Light.Compiler.Base.Target,UHC.Light.Compiler.Base.TermLike,UHC.Light.Compiler.Base.TreeTrie,UHC.Light.Compiler.Base.UID,UHC.Light.Compiler.CHR,UHC.Light.Compiler.CHR.Constraint,UHC.Light.Compiler.CHR.Key,UHC.Light.Compiler.CHR.Solve,UHC.Light.Compiler.CodeGen.BasicAnnot,UHC.Light.Compiler.CodeGen.Bits,UHC.Light.Compiler.CodeGen.BuiltinPrims,UHC.Light.Compiler.CodeGen.BuiltinSizeInfo,UHC.Light.Compiler.CodeGen.CVar,UHC.Light.Compiler.CodeGen.Const,UHC.Light.Compiler.CodeGen.ImportUsedModules,UHC.Light.Compiler.CodeGen.ModuleImportExportImpl,UHC.Light.Compiler.CodeGen.RefGenerator,UHC.Light.Compiler.CodeGen.Tag,UHC.Light.Compiler.CodeGen.TrfUtils,UHC.Light.Compiler.CodeGen.ValAccess,UHC.Light.Compiler.Config,UHC.Light.Compiler.ConfigCabal,UHC.Light.Compiler.ConfigDefines,UHC.Light.Compiler.ConfigInstall,UHC.Light.Compiler.ConfigInternalVersions,UHC.Light.Compiler.Core,UHC.Light.Compiler.Core.BindExtract,UHC.Light.Compiler.Core.Check,UHC.Light.Compiler.Core.Coercion,UHC.Light.Compiler.Core.ExtractFFE,UHC.Light.Compiler.Core.FFI,UHC.Light.Compiler.Core.FvS,UHC.Light.Compiler.Core.Merge,UHC.Light.Compiler.Core.ModAsMap,UHC.Light.Compiler.Core.Parser,UHC.Light.Compiler.Core.Pretty,UHC.Light.Compiler.Core.Subst,UHC.Light.Compiler.Core.SysF.AsTy,UHC.Light.Compiler.Core.ToCoreRun,UHC.Light.Compiler.Core.ToGrin,UHC.Light.Compiler.Core.Trf,UHC.Light.Compiler.Core.Trf.ANormal,UHC.Light.Compiler.Core.Trf.AnaRelevance,UHC.Light.Compiler.Core.Trf.AnnBasedSimplify,UHC.Light.Compiler.Core.Trf.CAFGlobalAsArg,UHC.Light.Compiler.Core.Trf.ConstProp,UHC.Light.Compiler.Core.Trf.ElimNonCodegenConstructs,UHC.Light.Compiler.Core.Trf.ElimTrivApp,UHC.Light.Compiler.Core.Trf.EraseExtractTysigCore,UHC.Light.Compiler.Core.Trf.EtaRed,UHC.Light.Compiler.Core.Trf.ExplicitStackTrace,UHC.Light.Compiler.Core.Trf.FixAfterParse,UHC.Light.Compiler.Core.Trf.FloatToGlobal,UHC.Light.Compiler.Core.Trf.InlineLetAlias,UHC.Light.Compiler.Core.Trf.LamGlobalAsArg,UHC.Light.Compiler.Core.Trf.LetDefBeforeUse,UHC.Light.Compiler.Core.Trf.LetFlattenStrict,UHC.Light.Compiler.Core.Trf.LetUnrec,UHC.Light.Compiler.Core.Trf.OptimizeStrictness,UHC.Light.Compiler.Core.Trf.RenUniq,UHC.Light.Compiler.Core.UsedModNms,UHC.Light.Compiler.Core.Utils,UHC.Light.Compiler.CoreRun,UHC.Light.Compiler.CoreRun.Parser,UHC.Light.Compiler.CoreRun.Pretty,UHC.Light.Compiler.CoreRun.Prim,UHC.Light.Compiler.CoreRun.Run,UHC.Light.Compiler.CoreRun.Run.Val,UHC.Light.Compiler.CoreRun.Run.Val.Prim,UHC.Light.Compiler.CoreRun.Run.Val.RunExplStk,UHC.Light.Compiler.CoreRun.Run.Val.RunImplStk,UHC.Light.Compiler.Deriving,UHC.Light.Compiler.EH,UHC.Light.Compiler.EH.MainAG,UHC.Light.Compiler.EH.MainAG_AGItf,UHC.Light.Compiler.EH.MainAG_CaseAlt,UHC.Light.Compiler.EH.MainAG_CaseAlts,UHC.Light.Compiler.EH.MainAG_DataConstr,UHC.Light.Compiler.EH.MainAG_DataConstrs,UHC.Light.Compiler.EH.MainAG_DataField,UHC.Light.Compiler.EH.MainAG_DataFieldExpr,UHC.Light.Compiler.EH.MainAG_DataFieldPatExpr,UHC.Light.Compiler.EH.MainAG_DataFields,UHC.Light.Compiler.EH.MainAG_Decl,UHC.Light.Compiler.EH.MainAG_Decls,UHC.Light.Compiler.EH.MainAG_Expr,UHC.Light.Compiler.EH.MainAG_ExprAnn,UHC.Light.Compiler.EH.MainAG_FuncDep,UHC.Light.Compiler.EH.MainAG_FuncDeps,UHC.Light.Compiler.EH.MainAG_KiExpr,UHC.Light.Compiler.EH.MainAG_KiExprAnn,UHC.Light.Compiler.EH.MainAG_MbTyExpr,UHC.Light.Compiler.EH.MainAG_PatExpr,UHC.Light.Compiler.EH.MainAG_PatExprAnn,UHC.Light.Compiler.EH.MainAG_PrExpr,UHC.Light.Compiler.EH.MainAG_PrExprs,UHC.Light.Compiler.EH.MainAG_RecExpr,UHC.Light.Compiler.EH.MainAG_RecPatExpr,UHC.Light.Compiler.EH.MainAG_RowTyExpr,UHC.Light.Compiler.EH.MainAG_TyExpr,UHC.Light.Compiler.EH.MainAG_TyExprAnn,UHC.Light.Compiler.EH.MainAG_TyExprs,UHC.Light.Compiler.EH.MainAG_TyVar,UHC.Light.Compiler.EH.MainAG_TyVars,UHC.Light.Compiler.EH.MainAG_common,UHC.Light.Compiler.EH.Parser,UHC.Light.Compiler.EHC.Common,UHC.Light.Compiler.EHC.CompileGroup,UHC.Light.Compiler.EHC.CompilePhase.Cleanup,UHC.Light.Compiler.EHC.CompilePhase.Common,UHC.Light.Compiler.EHC.CompilePhase.CompileC,UHC.Light.Compiler.EHC.CompilePhase.FlowBetweenPhase,UHC.Light.Compiler.EHC.CompilePhase.Link,UHC.Light.Compiler.EHC.CompilePhase.Module,UHC.Light.Compiler.EHC.CompilePhase.Output,UHC.Light.Compiler.EHC.CompilePhase.Parsers,UHC.Light.Compiler.EHC.CompilePhase.Run,UHC.Light.Compiler.EHC.CompilePhase.Semantics,UHC.Light.Compiler.EHC.CompilePhase.TopLevelPhases,UHC.Light.Compiler.EHC.CompilePhase.Transformations,UHC.Light.Compiler.EHC.CompilePhase.Translations,UHC.Light.Compiler.EHC.CompileRun,UHC.Light.Compiler.EHC.CompileUnit,UHC.Light.Compiler.EHC.Environment,UHC.Light.Compiler.EHC.InitialSetup,UHC.Light.Compiler.Error,UHC.Light.Compiler.Error.Pretty,UHC.Light.Compiler.FinalEnv,UHC.Light.Compiler.Foreign,UHC.Light.Compiler.Foreign.Boxing,UHC.Light.Compiler.Foreign.Extract,UHC.Light.Compiler.Foreign.Parser,UHC.Light.Compiler.Foreign.Pretty,UHC.Light.Compiler.Gam,UHC.Light.Compiler.Gam.AppSpineGam,UHC.Light.Compiler.Gam.Base,UHC.Light.Compiler.Gam.ClGam,UHC.Light.Compiler.Gam.ClassDefaultGam,UHC.Light.Compiler.Gam.DataGam,UHC.Light.Compiler.Gam.FixityGam,UHC.Light.Compiler.Gam.Full,UHC.Light.Compiler.Gam.Instantiate,UHC.Light.Compiler.Gam.KiGam,UHC.Light.Compiler.Gam.PolGam,UHC.Light.Compiler.Gam.Quantify,UHC.Light.Compiler.Gam.TyGam,UHC.Light.Compiler.Gam.TyKiGam,UHC.Light.Compiler.Gam.Utils,UHC.Light.Compiler.Gam.ValGam,UHC.Light.Compiler.Generics,UHC.Light.Compiler.HI,UHC.Light.Compiler.HS,UHC.Light.Compiler.HS.MainAG,UHC.Light.Compiler.HS.ModImpExp,UHC.Light.Compiler.HS.Parser,UHC.Light.Compiler.LamInfo,UHC.Light.Compiler.Module.ImportExport,UHC.Light.Compiler.Module.Merge,UHC.Light.Compiler.NameAspect,UHC.Light.Compiler.Opts,UHC.Light.Compiler.Opts.Base,UHC.Light.Compiler.Opts.CommandLine,UHC.Light.Compiler.Pred,UHC.Light.Compiler.Pred.CHR,UHC.Light.Compiler.Pred.CommonCHR,UHC.Light.Compiler.Pred.Evidence,UHC.Light.Compiler.Pred.EvidenceToCore,UHC.Light.Compiler.Pred.Heuristics,UHC.Light.Compiler.Pred.RedGraph,UHC.Light.Compiler.Pred.ToCHR,UHC.Light.Compiler.Scanner.Common,UHC.Light.Compiler.Scanner.Machine,UHC.Light.Compiler.Scanner.Scanner,UHC.Light.Compiler.Scanner.Token,UHC.Light.Compiler.Scanner.TokenParser,UHC.Light.Compiler.SourceCodeSig,UHC.Light.Compiler.Substitutable,UHC.Light.Compiler.Ty,UHC.Light.Compiler.Ty.AppSpineGam,UHC.Light.Compiler.Ty.FIEnv,UHC.Light.Compiler.Ty.FIEnv2,UHC.Light.Compiler.Ty.FitsIn,UHC.Light.Compiler.Ty.FitsInCommon,UHC.Light.Compiler.Ty.FitsInCommon2,UHC.Light.Compiler.Ty.Ftv,UHC.Light.Compiler.Ty.Parser,UHC.Light.Compiler.Ty.Pretty,UHC.Light.Compiler.Ty.TreeTrieKey,UHC.Light.Compiler.Ty.Trf.BetaReduce,UHC.Light.Compiler.Ty.Trf.Canonic,UHC.Light.Compiler.Ty.Trf.FreshVar,UHC.Light.Compiler.Ty.Trf.Instantiate,UHC.Light.Compiler.Ty.Trf.MergePreds,UHC.Light.Compiler.Ty.Trf.Quantify,UHC.Light.Compiler.Ty.Trf.Subst,UHC.Light.Compiler.Ty.UsedNames,UHC.Light.Compiler.Ty.Utils1,UHC.Light.Compiler.Ty.Utils2,UHC.Light.Compiler.VarLookup,UHC.Light.Compiler.VarMp,UHC.Light.Compiler.VarMp.Utils + Other-Modules: Paths_uhc_light,UHC.Light.Compiler.AbstractCore,UHC.Light.Compiler.AbstractCore.Utils,UHC.Light.Compiler.AnaDomain,UHC.Light.Compiler.AnaDomain.Ftv,UHC.Light.Compiler.AnaDomain.Pretty,UHC.Light.Compiler.AnaDomain.Trf.Instantiate,UHC.Light.Compiler.AnaDomain.Trf.Subst,UHC.Light.Compiler.AnaDomain.Utils,UHC.Light.Compiler.Base.CfgPP,UHC.Light.Compiler.Base.Common,UHC.Light.Compiler.Base.Debug,UHC.Light.Compiler.Base.FileSearchLocation,UHC.Light.Compiler.Base.Fld,UHC.Light.Compiler.Base.HsName,UHC.Light.Compiler.Base.HsName.Builtin,UHC.Light.Compiler.Base.Optimize,UHC.Light.Compiler.Base.PackageDatabase,UHC.Light.Compiler.Base.ParseUtils,UHC.Light.Compiler.Base.Parser,UHC.Light.Compiler.Base.Parser2,UHC.Light.Compiler.Base.Pragma,UHC.Light.Compiler.Base.RLList,UHC.Light.Compiler.Base.Range,UHC.Light.Compiler.Base.Strictness,UHC.Light.Compiler.Base.Target,UHC.Light.Compiler.Base.TermLike,UHC.Light.Compiler.Base.TreeTrie,UHC.Light.Compiler.Base.UID,UHC.Light.Compiler.CHR,UHC.Light.Compiler.CHR.Constraint,UHC.Light.Compiler.CHR.Key,UHC.Light.Compiler.CHR.Solve,UHC.Light.Compiler.CodeGen.BasicAnnot,UHC.Light.Compiler.CodeGen.Bits,UHC.Light.Compiler.CodeGen.BuiltinPrims,UHC.Light.Compiler.CodeGen.BuiltinSizeInfo,UHC.Light.Compiler.CodeGen.CVar,UHC.Light.Compiler.CodeGen.Const,UHC.Light.Compiler.CodeGen.ImportUsedModules,UHC.Light.Compiler.CodeGen.ModuleImportExportImpl,UHC.Light.Compiler.CodeGen.RefGenerator,UHC.Light.Compiler.CodeGen.Tag,UHC.Light.Compiler.CodeGen.TrfUtils,UHC.Light.Compiler.CodeGen.ValAccess,UHC.Light.Compiler.Config,UHC.Light.Compiler.ConfigCabal,UHC.Light.Compiler.ConfigDefines,UHC.Light.Compiler.ConfigInstall,UHC.Light.Compiler.ConfigInternalVersions,UHC.Light.Compiler.Core,UHC.Light.Compiler.Core.BindExtract,UHC.Light.Compiler.Core.Check,UHC.Light.Compiler.Core.Coercion,UHC.Light.Compiler.Core.ExtractFFE,UHC.Light.Compiler.Core.FFI,UHC.Light.Compiler.Core.FvS,UHC.Light.Compiler.Core.Merge,UHC.Light.Compiler.Core.ModAsMap,UHC.Light.Compiler.Core.Parser,UHC.Light.Compiler.Core.Pretty,UHC.Light.Compiler.Core.Subst,UHC.Light.Compiler.Core.SysF.AsTy,UHC.Light.Compiler.Core.ToCoreRun,UHC.Light.Compiler.Core.ToGrin,UHC.Light.Compiler.Core.Trf,UHC.Light.Compiler.Core.Trf.ANormal,UHC.Light.Compiler.Core.Trf.AnaRelevance,UHC.Light.Compiler.Core.Trf.AnnBasedSimplify,UHC.Light.Compiler.Core.Trf.CAFGlobalAsArg,UHC.Light.Compiler.Core.Trf.ConstProp,UHC.Light.Compiler.Core.Trf.ElimNonCodegenConstructs,UHC.Light.Compiler.Core.Trf.ElimTrivApp,UHC.Light.Compiler.Core.Trf.EraseExtractTysigCore,UHC.Light.Compiler.Core.Trf.EtaRed,UHC.Light.Compiler.Core.Trf.ExplicitStackTrace,UHC.Light.Compiler.Core.Trf.FixAfterParse,UHC.Light.Compiler.Core.Trf.FloatToGlobal,UHC.Light.Compiler.Core.Trf.InlineLetAlias,UHC.Light.Compiler.Core.Trf.LamGlobalAsArg,UHC.Light.Compiler.Core.Trf.LetDefBeforeUse,UHC.Light.Compiler.Core.Trf.LetFlattenStrict,UHC.Light.Compiler.Core.Trf.LetUnrec,UHC.Light.Compiler.Core.Trf.OptimizeStrictness,UHC.Light.Compiler.Core.Trf.RenUniq,UHC.Light.Compiler.Core.UsedModNms,UHC.Light.Compiler.Core.Utils,UHC.Light.Compiler.CoreRun,UHC.Light.Compiler.CoreRun.Check,UHC.Light.Compiler.CoreRun.Parser,UHC.Light.Compiler.CoreRun.Pretty,UHC.Light.Compiler.CoreRun.Prim,UHC.Light.Compiler.CoreRun.Run,UHC.Light.Compiler.CoreRun.Run.Val,UHC.Light.Compiler.CoreRun.Run.Val.Prim,UHC.Light.Compiler.CoreRun.Run.Val.RunExplStk,UHC.Light.Compiler.CoreRun.Run.Val.RunImplStk,UHC.Light.Compiler.Deriving,UHC.Light.Compiler.EH,UHC.Light.Compiler.EH.MainAG,UHC.Light.Compiler.EH.MainAG_AGItf,UHC.Light.Compiler.EH.MainAG_CaseAlt,UHC.Light.Compiler.EH.MainAG_CaseAlts,UHC.Light.Compiler.EH.MainAG_DataConstr,UHC.Light.Compiler.EH.MainAG_DataConstrs,UHC.Light.Compiler.EH.MainAG_DataField,UHC.Light.Compiler.EH.MainAG_DataFieldExpr,UHC.Light.Compiler.EH.MainAG_DataFieldPatExpr,UHC.Light.Compiler.EH.MainAG_DataFields,UHC.Light.Compiler.EH.MainAG_Decl,UHC.Light.Compiler.EH.MainAG_Decls,UHC.Light.Compiler.EH.MainAG_Expr,UHC.Light.Compiler.EH.MainAG_ExprAnn,UHC.Light.Compiler.EH.MainAG_FuncDep,UHC.Light.Compiler.EH.MainAG_FuncDeps,UHC.Light.Compiler.EH.MainAG_KiExpr,UHC.Light.Compiler.EH.MainAG_KiExprAnn,UHC.Light.Compiler.EH.MainAG_MbTyExpr,UHC.Light.Compiler.EH.MainAG_PatExpr,UHC.Light.Compiler.EH.MainAG_PatExprAnn,UHC.Light.Compiler.EH.MainAG_PrExpr,UHC.Light.Compiler.EH.MainAG_PrExprs,UHC.Light.Compiler.EH.MainAG_RecExpr,UHC.Light.Compiler.EH.MainAG_RecPatExpr,UHC.Light.Compiler.EH.MainAG_RowTyExpr,UHC.Light.Compiler.EH.MainAG_TyExpr,UHC.Light.Compiler.EH.MainAG_TyExprAnn,UHC.Light.Compiler.EH.MainAG_TyExprs,UHC.Light.Compiler.EH.MainAG_TyVar,UHC.Light.Compiler.EH.MainAG_TyVars,UHC.Light.Compiler.EH.MainAG_common,UHC.Light.Compiler.EH.Parser,UHC.Light.Compiler.EHC.BuildFunction,UHC.Light.Compiler.EHC.BuildFunction.Run,UHC.Light.Compiler.EHC.Common,UHC.Light.Compiler.EHC.CompileGroup,UHC.Light.Compiler.EHC.CompilePhase.Cleanup,UHC.Light.Compiler.EHC.CompilePhase.Common,UHC.Light.Compiler.EHC.CompilePhase.CompileC,UHC.Light.Compiler.EHC.CompilePhase.FlowBetweenPhase,UHC.Light.Compiler.EHC.CompilePhase.Link,UHC.Light.Compiler.EHC.CompilePhase.Module,UHC.Light.Compiler.EHC.CompilePhase.Output,UHC.Light.Compiler.EHC.CompilePhase.Parsers,UHC.Light.Compiler.EHC.CompilePhase.Run,UHC.Light.Compiler.EHC.CompilePhase.Semantics,UHC.Light.Compiler.EHC.CompilePhase.TopLevelPhases,UHC.Light.Compiler.EHC.CompilePhase.Transformations,UHC.Light.Compiler.EHC.CompilePhase.Translations,UHC.Light.Compiler.EHC.CompileRun,UHC.Light.Compiler.EHC.CompileUnit,UHC.Light.Compiler.EHC.Environment,UHC.Light.Compiler.EHC.InitialSetup,UHC.Light.Compiler.Error,UHC.Light.Compiler.Error.Pretty,UHC.Light.Compiler.FinalEnv,UHC.Light.Compiler.Foreign,UHC.Light.Compiler.Foreign.Boxing,UHC.Light.Compiler.Foreign.Extract,UHC.Light.Compiler.Foreign.Parser,UHC.Light.Compiler.Foreign.Pretty,UHC.Light.Compiler.Gam,UHC.Light.Compiler.Gam.AppSpineGam,UHC.Light.Compiler.Gam.Base,UHC.Light.Compiler.Gam.ClGam,UHC.Light.Compiler.Gam.ClassDefaultGam,UHC.Light.Compiler.Gam.DataGam,UHC.Light.Compiler.Gam.FixityGam,UHC.Light.Compiler.Gam.Full,UHC.Light.Compiler.Gam.Instantiate,UHC.Light.Compiler.Gam.KiGam,UHC.Light.Compiler.Gam.PolGam,UHC.Light.Compiler.Gam.Quantify,UHC.Light.Compiler.Gam.TyGam,UHC.Light.Compiler.Gam.TyKiGam,UHC.Light.Compiler.Gam.Utils,UHC.Light.Compiler.Gam.ValGam,UHC.Light.Compiler.Generics,UHC.Light.Compiler.HI,UHC.Light.Compiler.HS,UHC.Light.Compiler.HS.MainAG,UHC.Light.Compiler.HS.ModImpExp,UHC.Light.Compiler.HS.Parser,UHC.Light.Compiler.LamInfo,UHC.Light.Compiler.Module.ImportExport,UHC.Light.Compiler.Module.Merge,UHC.Light.Compiler.NameAspect,UHC.Light.Compiler.Opts,UHC.Light.Compiler.Opts.Base,UHC.Light.Compiler.Opts.CommandLine,UHC.Light.Compiler.Pred,UHC.Light.Compiler.Pred.CHR,UHC.Light.Compiler.Pred.CommonCHR,UHC.Light.Compiler.Pred.Evidence,UHC.Light.Compiler.Pred.EvidenceToCore,UHC.Light.Compiler.Pred.Heuristics,UHC.Light.Compiler.Pred.RedGraph,UHC.Light.Compiler.Pred.ToCHR,UHC.Light.Compiler.Scanner.Common,UHC.Light.Compiler.Scanner.Machine,UHC.Light.Compiler.Scanner.Scanner,UHC.Light.Compiler.Scanner.Token,UHC.Light.Compiler.Scanner.TokenParser,UHC.Light.Compiler.SourceCodeSig,UHC.Light.Compiler.Substitutable,UHC.Light.Compiler.Ty,UHC.Light.Compiler.Ty.AppSpineGam,UHC.Light.Compiler.Ty.FIEnv,UHC.Light.Compiler.Ty.FIEnv2,UHC.Light.Compiler.Ty.FitsIn,UHC.Light.Compiler.Ty.FitsInCommon,UHC.Light.Compiler.Ty.FitsInCommon2,UHC.Light.Compiler.Ty.Ftv,UHC.Light.Compiler.Ty.Parser,UHC.Light.Compiler.Ty.Pretty,UHC.Light.Compiler.Ty.TreeTrieKey,UHC.Light.Compiler.Ty.Trf.BetaReduce,UHC.Light.Compiler.Ty.Trf.Canonic,UHC.Light.Compiler.Ty.Trf.FreshVar,UHC.Light.Compiler.Ty.Trf.Instantiate,UHC.Light.Compiler.Ty.Trf.MergePreds,UHC.Light.Compiler.Ty.Trf.Quantify,UHC.Light.Compiler.Ty.Trf.Subst,UHC.Light.Compiler.Ty.UsedNames,UHC.Light.Compiler.Ty.Utils1,UHC.Light.Compiler.Ty.Utils2,UHC.Light.Compiler.VarLookup,UHC.Light.Compiler.VarMp,UHC.Light.Compiler.VarMp.Utils Executable uhcl Hs-Source-Dirs: src-main - Build-Depends: uhc-light==1.1.8.6, fgl,hashable>=1.1&&<1.3,uhc-util>=0.1.3.7,base>=4&&<5,vector,syb,uulib,network,binary,mtl,directory,containers,array,process,primitive,binary,syb,bytestring,uulib>=0.9.12,old-locale+ Build-Depends: uhc-light==1.1.8.7, fgl,hashable>=1.1&&<1.3,uhc-util>=0.1.3.7,base>=4&&<5,vector,syb,uulib,network,binary,mtl,directory,containers,array,process,primitive,binary,syb,bytestring,uulib>=0.9.12,old-locale Extensions: RankNTypes,MultiParamTypeClasses,FunctionalDependencies,UndecidableInstances,DeriveDataTypeable,OverlappingInstances,LiberalTypeSynonyms,StandaloneDeriving,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,ScopedTypeVariables Main-Is: EHC.hs Executable uhcr Hs-Source-Dirs: src-main - Build-Depends: uhc-light==1.1.8.6, fgl,hashable>=1.1&&<1.3,uhc-util>=0.1.3.7,base>=4&&<5,vector,syb,uulib,network,binary,mtl,directory,containers,array,process,filepath,primitive,binary,syb,bytestring,uulib>=0.9.12,old-locale+ Build-Depends: uhc-light==1.1.8.7, fgl,hashable>=1.1&&<1.3,uhc-util>=0.1.5.0,base>=4&&<5,vector,syb,uulib,network,binary,mtl,directory,containers,array,process,filepath,primitive,binary,syb,bytestring,uulib>=0.9.12,old-locale Extensions: RankNTypes,MultiParamTypeClasses,FunctionalDependencies,UndecidableInstances,DeriveDataTypeable,OverlappingInstances,LiberalTypeSynonyms,StandaloneDeriving,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,ScopedTypeVariables Main-Is: EHCRun.hs